|
98
|
1 ;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
3 ;;
|
|
|
4 ;; File: efs.el
|
|
|
5 ;; Release: $efs release: 1.15 $
|
|
|
6 ;; Version: $Revision: 1.2 $
|
|
|
7 ;; RCS:
|
|
|
8 ;; Description: Transparent FTP support for the original GNU Emacs
|
|
|
9 ;; from FSF and Lucid Emacs
|
|
|
10 ;; Authors: Andy Norman <ange@hplb.hpl.hp.com>,
|
|
|
11 ;; Sandy Rutherford <sandy@ibm550.sissa.it>
|
|
|
12 ;; Created: Thu Oct 12 14:00:05 1989 (as ange-ftp)
|
|
|
13 ;;
|
|
|
14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
15
|
|
|
16 ;;; The following restrictions apply to all of the files in the efs
|
|
|
17 ;;; distribution.
|
|
|
18 ;;;
|
|
|
19 ;;; Copyright (C) 1993 Andy Norman / Sandy Rutherford
|
|
|
20 ;;;
|
|
|
21 ;;; Authors:
|
|
|
22 ;;; Andy Norman (ange@hplb.hpl.hp.com)
|
|
|
23 ;;; Sandy Rutherford (sandy@ibm550.sissa.it)
|
|
|
24 ;;;
|
|
|
25 ;;; The authors of some of the sub-files of efs are different
|
|
|
26 ;;; from the above. We are very grateful to people who have
|
|
|
27 ;;; contributed code to efs.
|
|
|
28 ;;;
|
|
|
29 ;;; This program is free software; you can redistribute it and/or modify
|
|
|
30 ;;; it under the terms of the GNU General Public License as published by
|
|
|
31 ;;; the Free Software Foundation; either version 1, or (at your option)
|
|
|
32 ;;; any later version.
|
|
|
33 ;;;
|
|
|
34 ;;; This program is distributed in the hope that it will be useful,
|
|
|
35 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
36 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
37 ;;; GNU General Public License for more details.
|
|
|
38 ;;;
|
|
|
39 ;;; A copy of the GNU General Public License can be obtained from this
|
|
|
40 ;;; program's authors (send electronic mail to ange@hplb.hpl.hp.com) or
|
|
|
41 ;;; from the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
|
|
|
42 ;;; MA 02139, USA.
|
|
|
43
|
|
|
44 ;;; Description:
|
|
|
45 ;;;
|
|
|
46 ;;; This package attempts to make accessing files and directories on
|
|
|
47 ;;; remote computers from within GNU Emacs as simple and transparent
|
|
|
48 ;;; as possible. Currently all remote files are accessed using FTP.
|
|
|
49 ;;; The goal is to make the entire internet accessible as a virtual
|
|
|
50 ;;; file system.
|
|
|
51
|
|
|
52 ;;; Acknowledgements: << please add to this list >>
|
|
|
53 ;;;
|
|
|
54 ;;; Corny de Souza for writing efs-mpe.el.
|
|
|
55 ;;; Jamie Zawinski for writing efs-ti-twenex.el and efs-ti-explorer.el
|
|
|
56 ;;; Joe Wells for writing the first pass at vms support for ange-ftp.el.
|
|
|
57 ;;; Sebastian Kremer for helping with dired support.
|
|
|
58 ;;; Ishikawa Ichiro for MULE support.
|
|
|
59 ;;;
|
|
|
60 ;;; Many other people have contributed code, advice, and beta testing
|
|
|
61 ;;; (sometimes without even realizing it) to both ange-ftp and efs:
|
|
|
62 ;;;
|
|
|
63 ;;; Rob Austein, Doug Bagley, Andy Caiger, Jim Franklin, Noah
|
|
|
64 ;;; Friedman, Aksnes Knut-Havard, Elmar Heeb, John Interrante, Roland
|
|
|
65 ;;; McGrath, Jeff Morgenthaler, Mike Northam, Jens Petersen, Jack
|
|
|
66 ;;; Repenning, Joerg-Martin Schwarz, Michael Sperber, Svein Tjemsland,
|
|
|
67 ;;; Andy Whitcroft, Raymond A. Wiker
|
|
|
68 ;;;
|
|
|
69 ;;; Also, thank you to all the people on the efs-testers mailing list.
|
|
|
70 ;;;
|
|
|
71
|
|
|
72 ;;; --------------------------------------------------------------
|
|
|
73 ;;; Documentation:
|
|
|
74 ;;; --------------------------------------------------------------
|
|
|
75 ;;;
|
|
|
76 ;;; Currently efs does not have a tex info file, and what you are
|
|
|
77 ;;; reading represents the only efs documentation. Please report any
|
|
|
78 ;;; errors or omissions in this documentation to the "bugs" address
|
|
|
79 ;;; below. Eventually, a tex info file should be written. If you have
|
|
|
80 ;;; any problems with efs, please read this section *before*
|
|
|
81 ;;; submitting a bug report.
|
|
|
82
|
|
|
83 ;;; Installation:
|
|
|
84 ;;;
|
|
|
85 ;;; For byte compiling the efs package, a Makefile is provided.
|
|
|
86 ;;; You should follow the instructions at the top of the Makefile.
|
|
|
87 ;;; If you have any problems, please let us know so that we can fix
|
|
|
88 ;;; them for other users. Don't even consider using efs without
|
|
|
89 ;;; byte compiling it. It will be far too slow.
|
|
|
90 ;;;
|
|
|
91 ;;; If you decide to byte compile efs by hand, it is important that
|
|
|
92 ;;; the file efs-defun.el be byte compiled first, followed by efs.el.
|
|
|
93 ;;; The other files may be byte compiled in any order.
|
|
|
94 ;;;
|
|
|
95 ;;; To use efs, simply put the byte compiled files in your load path
|
|
|
96 ;;; and add
|
|
|
97 ;;;
|
|
|
98 ;;; (require 'efs)
|
|
|
99 ;;;
|
|
|
100 ;;; in your .emacs file.
|
|
|
101 ;;;
|
|
|
102 ;;; If you would like efs to be autoloaded when you attempt to access
|
|
|
103 ;;; a remote file, put
|
|
|
104 ;;;
|
|
|
105 ;;; (require 'efs-auto)
|
|
|
106 ;;;
|
|
|
107 ;;; in your .emacs file. Note that there are some limitations associated
|
|
|
108 ;;; with autoloading efs. A discussion of them is given at the top of
|
|
|
109 ;;; efs-auto.el.
|
|
|
110
|
|
|
111 ;;; Configuration variables:
|
|
|
112 ;;;
|
|
|
113 ;;; It is important that you read through the section on user customization
|
|
|
114 ;;; variables (search forward for the string ">>>"). If your local network
|
|
|
115 ;;; is not fully connected to the internet, but accesses the internet only
|
|
|
116 ;;; via a gateway, then it is vital to set the appropriate variables to
|
|
|
117 ;;; inform efs about the geometry of your local network. Also, see the
|
|
|
118 ;;; paragraph on gateways below.
|
|
|
119
|
|
|
120 ;;; Usage:
|
|
|
121 ;;;
|
|
|
122 ;;; Once installed, efs operates largely transparently. All files
|
|
|
123 ;;; normally accessible to you on the internet, become part of a large
|
|
|
124 ;;; virtual file system. These files are accessed using an extended
|
|
|
125 ;;; file name syntax. To access file <path> on remote host <host> by
|
|
|
126 ;;; logging in as user <user>, you simply specify the full path of the
|
|
|
127 ;;; file as /<user>@<host>:<path>. Nearly all GNU Emacs file handling
|
|
|
128 ;;; functions work for remote files. It is not possible to access
|
|
|
129 ;;; remote files using shell commands in an emacs *shell* buffer, as such
|
|
|
130 ;;; commands are passed directly to the shell, and not handled by emacs.
|
|
|
131 ;;; FTP is the underlying utility that efs uses to operate on remote files.
|
|
|
132 ;;;
|
|
|
133 ;;; For example, if find-file is given a filename of:
|
|
|
134 ;;;
|
|
|
135 ;;; /ange@anorman:/tmp/notes
|
|
|
136 ;;;
|
|
|
137 ;;; then efs will spawn an FTP process, connect to the host 'anorman' as
|
|
|
138 ;;; user 'ange', get the file '/tmp/notes' and pop up a buffer containing the
|
|
|
139 ;;; contents of that file as if it were on the local file system. If efs
|
|
|
140 ;;; needed a password to connect then it would prompt the user in the
|
|
|
141 ;;; minibuffer. For further discussion of the efs path syntax, see the
|
|
|
142 ;;; paragraph on extended file name syntax below.
|
|
|
143
|
|
|
144 ;;; Ports:
|
|
|
145 ;;;
|
|
|
146 ;;; efs supports the use of nonstandard ports on remote hosts.
|
|
|
147 ;;; To specify that port <port> should be used, give the host name as
|
|
|
148 ;;; host#<port>. Host names may be given in this form anywhere that efs
|
|
|
149 ;;; normally expects a host name. This includes in the .netrc file.
|
|
|
150 ;;; Logically, efs treats different ports to correspond to different
|
|
|
151 ;;; remote hosts.
|
|
|
152
|
|
|
153 ;;; Extended filename syntax:
|
|
|
154 ;;;
|
|
|
155 ;;; The default full efs path syntax is
|
|
|
156 ;;;
|
|
|
157 ;;; /<user>@<host>#<port>:<path>
|
|
|
158 ;;;
|
|
|
159 ;;; Both the `#<port>' and `<user>@' may be omitted.
|
|
|
160 ;;;
|
|
|
161 ;;; If the `#<port>' is omitted, then the default port is taken to be 21,
|
|
|
162 ;;; the usual FTP port. For most users, the port syntax will only
|
|
|
163 ;;; very rarely be necessary.
|
|
|
164 ;;;
|
|
|
165 ;;; If the `<user>@' is omitted, then efs will use a default user. If a
|
|
|
166 ;;; login token is specified in your .netrc file, then this will be used as
|
|
|
167 ;;; the default user for <host>. Otherwise, it is determined based on the
|
|
|
168 ;;; value of the variable efs-default-user.
|
|
|
169 ;;;
|
|
|
170 ;;; This efs path syntax can be customised to a certain extent by
|
|
|
171 ;;; changing a number of variables in the subsection Internal Variables.
|
|
|
172 ;;; To undertake such a customization requires some knowledge about the
|
|
|
173 ;;; internal workings of efs.
|
|
|
174
|
|
|
175 ;;; Passwords:
|
|
|
176 ;;;
|
|
|
177 ;;; A password is required for each host / user pair. This will be
|
|
|
178 ;;; prompted for when needed, unless already set by calling
|
|
|
179 ;;; efs-set-passwd, or specified in a *valid* ~/.netrc file.
|
|
|
180 ;;;
|
|
|
181 ;;; When efs prompts for a password, it provides defaults from its
|
|
|
182 ;;; cache of currently known passwords. The defaults are ordered such
|
|
|
183 ;;; that passwords for accounts which have the same user name as the
|
|
|
184 ;;; login which is currently underway have priority. You can cycle
|
|
|
185 ;;; through your list of defaults with C-n to cycle forwards and C-p
|
|
|
186 ;;; to cycle backwards. The list is circular.
|
|
|
187
|
|
|
188 ;;; Passwords for user "anonymous":
|
|
|
189 ;;;
|
|
|
190 ;;; Passwords for the user "anonymous" (or "ftp") are handled
|
|
|
191 ;;; specially. The variable efs-generate-anonymous-password controls
|
|
|
192 ;;; what happens. If the value of this variable is a string, then this
|
|
|
193 ;;; is used as the password; if non-nil, then a password is created
|
|
|
194 ;;; from the name of the user and the hostname of the machine on which
|
|
|
195 ;;; GNU Emacs is running; if nil (the default) then the user is
|
|
|
196 ;;; prompted for a password as normal.
|
|
|
197
|
|
|
198 ;;; "Dumb" UNIX hosts:
|
|
|
199 ;;;
|
|
|
200 ;;; The FTP servers on some UNIX machines have problems if the "ls"
|
|
|
201 ;;; command is used. efs will try to correct for this automatically,
|
|
|
202 ;;; and send the "dir" command instead. If it fails, you can call the
|
|
|
203 ;;; function efs-add-host, and give the host type as dumb-unix. Note
|
|
|
204 ;;; that this change will take effect for the current GNU Emacs
|
|
|
205 ;;; session only. To make this specification for future emacs
|
|
|
206 ;;; sessions, put
|
|
|
207 ;;;
|
|
|
208 ;;; (efs-add-host 'dumb-unix "hostname")
|
|
|
209 ;;;
|
|
|
210 ;;; in your .emacs file. Also, please report any failure to automatically
|
|
|
211 ;;; recognize dumb unix to the "bugs" address given below, so that we can
|
|
|
212 ;;; fix the auto recognition code.
|
|
|
213
|
|
|
214 ;;; File name completion:
|
|
|
215 ;;;
|
|
|
216 ;;; Full file-name completion is supported on every type of remote
|
|
|
217 ;;; host. To do filename completion, efs needs a listing from the
|
|
|
218 ;;; remote host. Therefore, for very slow connections, it might not
|
|
|
219 ;;; save any time. However, the listing is cached, so subsequent uses
|
|
|
220 ;;; of file-name completion will be just as fast as for local file
|
|
|
221 ;;; names.
|
|
|
222
|
|
|
223 ;;; FTP processes:
|
|
|
224 ;;;
|
|
|
225 ;;; When efs starts up an FTP process, it leaves it running for speed
|
|
|
226 ;;; purposes. Some FTP servers will close the connection after a period of
|
|
|
227 ;;; time, but efs should be able to quietly reconnect the next time that
|
|
|
228 ;;; the process is needed.
|
|
|
229 ;;;
|
|
|
230 ;;; The FTP process will be killed should the associated "*ftp user@host*"
|
|
|
231 ;;; buffer be deleted. This should not cause efs any grief.
|
|
|
232
|
|
|
233 ;;; Showing background FTP activity on the mode-line:
|
|
|
234 ;;;
|
|
|
235 ;;; After efs is loaded, the command efs-display-ftp-activity will cause
|
|
|
236 ;;; background FTP activity to be displayed on the mode line. The variable
|
|
|
237 ;;; efs-mode-line-format is used to determine how this data is displayed.
|
|
|
238 ;;; efs does not continuously track the number of active sessions, as this
|
|
|
239 ;;; would cause the display to change too rapidly. Rather, it uses a heuristic
|
|
|
240 ;;; algorithm to determine when there is a significant change in FTP activity.
|
|
|
241
|
|
|
242 ;;; File types:
|
|
|
243 ;;;
|
|
|
244 ;;; By default efs will assume that all files are ASCII. If a file
|
|
|
245 ;;; being transferred matches the value of efs-binary-file-name-regexp
|
|
|
246 ;;; then the file will be assumed to be a binary file, and efs will
|
|
|
247 ;;; transfer it using "type image". ASCII files will be transferred
|
|
|
248 ;;; using a transfer type which efs computes to be correct according
|
|
|
249 ;;; to its knowledge of the file system of the remote host. The
|
|
|
250 ;;; command `efs-prompt-for-transfer-type' toggles the variable
|
|
|
251 ;;; `efs-prompt-for-transfer-type'. When this variable is non-nil, efs
|
|
|
252 ;;; will prompt the user for the transfer type to use for every FTP
|
|
|
253 ;;; transfer. Having this set all the time is annoying, but it is
|
|
|
254 ;;; useful to give special treatment to a small set of files.
|
|
|
255 ;;; There is also variable efs-text-file-name-regexp. This is tested before
|
|
|
256 ;;; efs-binary-file-name-regexp, so if you set efs-text-file-name-regexp
|
|
|
257 ;;; to a non-trivial regular expression, and efs-binary-file-name-regexp
|
|
|
258 ;;; to ".*", the result will to make image the default tranfer type.
|
|
|
259 ;;;
|
|
|
260 ;;; Also, if you set efs-treat-crlf-as-nl, then efs will use type image
|
|
|
261 ;;; to transfer files between hosts whose file system differ only in that
|
|
|
262 ;;; one specifies end of line as CR-LF, and the other as NL. This is useful
|
|
|
263 ;;; if you are transferring files between UNIX and DOS machines, and have a
|
|
|
264 ;;; package such as dos-mode.el, that handles the extra ^M's.
|
|
|
265
|
|
|
266 ;;; Account passwords:
|
|
|
267 ;;;
|
|
|
268 ;;; Some FTP servers require an additional password which is sent by
|
|
|
269 ;;; the ACCOUNT command. efs will detect this and prompt the user for
|
|
|
270 ;;; an account password if the server expects one. Also, an account
|
|
|
271 ;;; password can be set by calling efs-set-account, or by specifying
|
|
|
272 ;;; an account token in the .netrc file.
|
|
|
273 ;;;
|
|
|
274 ;;; Some operating systems, such as CMS, require that ACCOUNT be used to
|
|
|
275 ;;; give a write access password for minidisks. efs-set-account can be used
|
|
|
276 ;;; to set a write password for a specific minidisk. Also, tokens of the form
|
|
|
277 ;;; minidisk <minidisk name> <password>
|
|
|
278 ;;; may be added to host lines in your .netrc file. Minidisk tokens must be
|
|
|
279 ;;; at the end of the host line, however there may be an arbitrary number of
|
|
|
280 ;;; them for any given host.
|
|
|
281
|
|
|
282 ;;; Preloading:
|
|
|
283 ;;;
|
|
|
284 ;;; efs can be preloaded, but must be put in the site-init.el file and
|
|
|
285 ;;; not the site-load.el file in order for the documentation strings for the
|
|
|
286 ;;; functions being overloaded to be available.
|
|
|
287
|
|
|
288 ;;; Status reports:
|
|
|
289 ;;;
|
|
|
290 ;;; Most efs commands that talk to the FTP process output a status
|
|
|
291 ;;; message on what they are doing. In addition, efs can take advantage
|
|
|
292 ;;; of the FTP client's HASH command to display the status of transferring
|
|
|
293 ;;; files and listing directories. See the documentation for the variables
|
|
|
294 ;;; efs-hash-mark-size, efs-send-hash and efs-verbose for more details.
|
|
|
295
|
|
|
296 ;;; Caching of directory information:
|
|
|
297 ;;;
|
|
|
298 ;;; efs keeps an internal cache of file listings from remote hosts.
|
|
|
299 ;;; If this cache gets out of synch, it can be renewed by reverting a
|
|
|
300 ;;; dired buffer for the appropriate directory (dired-revert is usually
|
|
|
301 ;;; bound to "g").
|
|
|
302 ;;;
|
|
|
303 ;;; Alternatively, you can add the following two lines to your .emacs file
|
|
|
304 ;;; if you want C-r to refresh efs's cache whilst doing filename
|
|
|
305 ;;; completion.
|
|
|
306 ;;; (define-key minibuffer-local-completion-map "\C-r" 'efs-re-read-dir)
|
|
|
307 ;;; (define-key minibuffer-local-must-match-map "\C-r" 'efs-re-read-dir)
|
|
|
308
|
|
|
309 ;;; Gateways:
|
|
|
310 ;;;
|
|
|
311 ;;; Sometimes it is neccessary for the FTP process to be run on a different
|
|
|
312 ;;; machine than the machine running GNU Emacs. This can happen when the
|
|
|
313 ;;; local machine has restrictions on what hosts it can access.
|
|
|
314 ;;;
|
|
|
315 ;;; efs has support for running the ftp process on a different (gateway)
|
|
|
316 ;;; machine. The way it works is as follows:
|
|
|
317 ;;;
|
|
|
318 ;;; 1) Set the variable 'efs-gateway-host' to the name of a machine
|
|
|
319 ;;; that doesn't have the access restrictions. If you need to use
|
|
|
320 ;;; a nonstandard port to access this host for gateway use, then
|
|
|
321 ;;; specify efs-gateway-host as "<hostname>#<port>".
|
|
|
322 ;;;
|
|
|
323 ;;; 2) Set the variable 'efs-ftp-local-host-regexp' to a regular expression
|
|
|
324 ;;; that matches hosts that can be contacted from running a local ftp
|
|
|
325 ;;; process, but fails to match hosts that can't be accessed locally. For
|
|
|
326 ;;; example:
|
|
|
327 ;;;
|
|
|
328 ;;; "\\.hp\\.com$\\|^[^.]*$"
|
|
|
329 ;;;
|
|
|
330 ;;; will match all hosts that are in the .hp.com domain, or don't have an
|
|
|
331 ;;; explicit domain in their name, but will fail to match hosts with
|
|
|
332 ;;; explicit domains or that are specified by their ip address.
|
|
|
333 ;;;
|
|
|
334 ;;; 3) Set the variable `efs-local-host-regexp' to machines that you have
|
|
|
335 ;;; direct TCP/IP access. In other words, you must be able to ping these
|
|
|
336 ;;; hosts. Usually, efs-ftp-local-host-regexp and efs-local-host-regexp
|
|
|
337 ;;; will be the same. However, they will differ for so-called transparent
|
|
|
338 ;;; gateways. See #7 below for more details.
|
|
|
339 ;;;
|
|
|
340 ;;; 4) Set the variable 'efs-gateway-tmp-name-template' to the name of
|
|
|
341 ;;; a directory plus an identifying filename prefix for making temporary
|
|
|
342 ;;; files on the gateway. For example: "/tmp/hplose/ange/efs"
|
|
|
343 ;;;
|
|
|
344 ;;; 5) If the gateway and the local host share cross-mounted directories,
|
|
|
345 ;;; set the value of `efs-gateway-mounted-dirs-alist' accordingly. It
|
|
|
346 ;;; is particularly useful, but not mandatory, that the directory
|
|
|
347 ;;; of `efs-gateway-tmp-name-template' be cross-mounted.
|
|
|
348 ;;;
|
|
|
349 ;;; 6) Set the variable `efs-gateway-type' to the type gateway that you have.
|
|
|
350 ;;; This variable is a list, the first element of which is a symbol
|
|
|
351 ;;; denoting the type of gateway. Following elements give further
|
|
|
352 ;;; data on the gateway.
|
|
|
353 ;;;
|
|
|
354 ;;; Supported gateway types:
|
|
|
355 ;;;
|
|
|
356 ;;; a) local:
|
|
|
357 ;;; This means that your local host is itself the gateway. However,
|
|
|
358 ;;; it is necessary to use a different FTP client to gain access to
|
|
|
359 ;;; the outside world. If the name of the FTP client were xftp, you might
|
|
|
360 ;;; set efs-gateway-type to
|
|
|
361 ;;;
|
|
|
362 ;;; (list 'local "xftp" efs-ftp-program-args)
|
|
|
363 ;;;
|
|
|
364 ;;; If xftp required special arguments, then give them in place of
|
|
|
365 ;;; efs-ftp-program-args. See the documentation for efs-ftp-program-args
|
|
|
366 ;;; for the syntax.
|
|
|
367 ;;;
|
|
|
368 ;;; b) proxy:
|
|
|
369 ;;; This indicates that your gateway works by first FTP'ing to it, and
|
|
|
370 ;;; then issuing a USER command of the form
|
|
|
371 ;;;
|
|
|
372 ;;; USER <username>@<host>
|
|
|
373 ;;;
|
|
|
374 ;;; In this case, you might set efs-gateway-type to
|
|
|
375 ;;;
|
|
|
376 ;;; (list 'proxy "ftp" efs-ftp-program-args)
|
|
|
377 ;;;
|
|
|
378 ;;; If you need to use a nonstandard client, such as iftp, give this
|
|
|
379 ;;; instead of "ftp". If this client needs to take special arguments,
|
|
|
380 ;;; give them instead of efs-ftp-program-args.
|
|
|
381 ;;;
|
|
|
382 ;;; c) remsh:
|
|
|
383 ;;; For this type of gateway, you need to start a remote shell on
|
|
|
384 ;;; your gateway, using either remsh or rsh. You should set
|
|
|
385 ;;; efs-gateway-type to something like
|
|
|
386 ;;;
|
|
|
387 ;;; (list 'remsh "remsh" nil "ftp" efs-ftp-program-args)
|
|
|
388 ;;;
|
|
|
389 ;;; If you use rsh instead of remsh, change the second element from
|
|
|
390 ;;; "remsh" to "rsh". Note that the symbol indicating the gateway
|
|
|
391 ;;; type should still be 'remsh. If you want to pass arguments
|
|
|
392 ;;; to the remsh program, give them as the third element. For example,
|
|
|
393 ;;; if you need to specify a user, make this (list "-l" "sandy").
|
|
|
394 ;;; If you need to use a nonstandard FTP client, specify that as the fourth
|
|
|
395 ;;; element. If your FTP client needs to be given special arguments,
|
|
|
396 ;;; give them instead of efs-ftp-program-args.
|
|
|
397 ;;;
|
|
|
398 ;;; d) interactive:
|
|
|
399 ;;; This indicates that you need to establish a login on the gateway,
|
|
|
400 ;;; using either telnet or rlogin.
|
|
|
401 ;;; You should set efs-gateway-type to something like
|
|
|
402 ;;;
|
|
|
403 ;;; (list 'interactive "rlogin" nil "exec ftp" efs-ftp-program-args)
|
|
|
404 ;;;
|
|
|
405 ;;; If you need to use telnet, then give "telnet" in place of the second
|
|
|
406 ;;; element "rlogin". If your login program needs to be given arguments,
|
|
|
407 ;;; then they should be given in the third slot. The fourth element
|
|
|
408 ;;; is for the name of the FTP client program. Giving this as "exec ftp",
|
|
|
409 ;;; instead of "ftp", ensures that you are logged out if the FTP client
|
|
|
410 ;;; dies. If the FTP client takes special arguments, give these instead
|
|
|
411 ;;; of efs-ftp-program-args. Furthermore, you should see the documentation
|
|
|
412 ;;; at the top of efs-gwp.el. You may need to set the variables
|
|
|
413 ;;; efs-gwp-setup-term-command, and efs-gwp-prompt-pattern.
|
|
|
414 ;;;
|
|
|
415 ;;; e) raptor:
|
|
|
416 ;;; This is a type of gateway where efs is expected to specify a gateway
|
|
|
417 ;;; user, and send a password for this user using the ACCOUNT command.
|
|
|
418 ;;; For example, to log in to foobar.edu as sandy, while using the account
|
|
|
419 ;;; ange on the gateway, the following commands would be sent:
|
|
|
420 ;;;
|
|
|
421 ;;; open raptorgate.com
|
|
|
422 ;;; quote USER sandy@foobar.edu ange
|
|
|
423 ;;; quote pass <sandy's password on foobar>
|
|
|
424 ;;; quote account <ange's password on raptorgate>
|
|
|
425 ;;;
|
|
|
426 ;;; For such a gateway, you would set efs-gateway-type to
|
|
|
427 ;;;
|
|
|
428 ;;; (list 'raptor efs-ftp-program efs-ftp-program-args <GATEWAY USER>)
|
|
|
429 ;;;
|
|
|
430 ;;; where <GATEWAY USER> is the name of your account on the gateway. In
|
|
|
431 ;;; the above example, this would be "ange". You can set your gateway
|
|
|
432 ;;; password by simply setting an account password for the gateway host.
|
|
|
433 ;;; This can be done with either efs-set-account, or within your .netrc
|
|
|
434 ;;; file. If no password is set, you will be prompted for one.
|
|
|
435 ;;;
|
|
|
436 ;;; f) interlock:
|
|
|
437 ;;; This is a type of gateway where you are expected to send a PASS
|
|
|
438 ;;; command after opening the connection to the gateway.
|
|
|
439 ;;; The precise login sequence is
|
|
|
440 ;;;
|
|
|
441 ;;; open interlockgate
|
|
|
442 ;;; quote PASS <sandy's password on interlockgate>
|
|
|
443 ;;; quote USER sandy@foobar.edu
|
|
|
444 ;;; quote PASS <sandy's password on foobar.edu>
|
|
|
445 ;;;
|
|
|
446 ;;; For such a gateway, you should set efs-gateway-type to
|
|
|
447 ;;;
|
|
|
448 ;;; (list 'interlock efs-ftp-program efs-ftp-program-args)
|
|
|
449 ;;;
|
|
|
450 ;;; If you need to use a nonstandard name for your FTP client,
|
|
|
451 ;;; then replace efs-ftp-program with this name. If your FTP client
|
|
|
452 ;;; needs to take nonstandard arguments, then replace efs-ftp-program-args
|
|
|
453 ;;; with these arguments. See efs-ftp-program-args <V> for the required
|
|
|
454 ;;; syntax.
|
|
|
455 ;;;
|
|
|
456 ;;; If your gateway returns both a 220 code and a 331 code to the
|
|
|
457 ;;; "open interlockgate" command, then you should add a regular
|
|
|
458 ;;; expression to efs-skip-msgs <V> that matches the 220 response.
|
|
|
459 ;;; Returning two response codes to a single FTP command is not permitted
|
|
|
460 ;;; in RFC 959. It is not possible for efs to ignore the 220 by default,
|
|
|
461 ;;; because than it would hang for interlock installations which do not
|
|
|
462 ;;; require a password.
|
|
|
463 ;;;
|
|
|
464 ;;; g) kerberos:
|
|
|
465 ;;; With this gateway, you need to authenticate yourself by getting a
|
|
|
466 ;;; kerberos "ticket" first. Usually, this is done with the kinit program.
|
|
|
467 ;;; Once authenticated, you connect to foobar.com as user sandy with the
|
|
|
468 ;;; sequence: (Note that the "-n" argument inhibits automatic login.
|
|
|
469 ;;; Although, in manual use you probably don't use it, efs always uses it.)
|
|
|
470 ;;;
|
|
|
471 ;;; iftp -n
|
|
|
472 ;;; open foobar.com
|
|
|
473 ;;; user sandy@foobar.com
|
|
|
474 ;;;
|
|
|
475 ;;; You should set efs-gateway-type to something like
|
|
|
476 ;;;
|
|
|
477 ;;; (list 'kerberos "iftp" efs-ftp-program-args "kinit" <KINIT-ARGS>)
|
|
|
478 ;;;
|
|
|
479 ;;; If you use an FTP client other than iftp, insert its name instead
|
|
|
480 ;;; of "iftp" above. If your FTP client needs special arguments, give
|
|
|
481 ;;; them as a list of strings in place of efs-ftp-program-args. If
|
|
|
482 ;;; the program that you use to collect a ticket in not called "kinit",
|
|
|
483 ;;; then give its name in place of "kinit" above. <KINIT-ARGS> should be
|
|
|
484 ;;; any arguments that you need to pass to your kinit program, given as a
|
|
|
485 ;;; list of strings. Most likely, you will give this as nil.
|
|
|
486 ;;;
|
|
|
487 ;;; See the file efs-kerberos.el for more configuration variables. If you
|
|
|
488 ;;; need to adjust any of these variables, please report this to us so that
|
|
|
489 ;;; we can fix them for other users.
|
|
|
490 ;;;
|
|
|
491 ;;; If efs detects that you are not authenticated to use the gateway, it
|
|
|
492 ;;; will run the kinit program automatically, prompting you for a password.
|
|
|
493 ;;; If you give a password in your .netrc file for login the value of
|
|
|
494 ;;; efs-gateway-host <V> and user kerberos, then efs will use this to
|
|
|
495 ;;; obtain gateway authentication.
|
|
|
496 ;;;
|
|
|
497 ;;; 7) Transparent gateways:
|
|
|
498 ;;;
|
|
|
499 ;;; If your gateway is completely transparent (for example it uses
|
|
|
500 ;;; socks), then you should set efs-gateway-type to nil. Also,
|
|
|
501 ;;; set efs-ftp-local-host-regexp to ".*". However, efs-local-host-regexp,
|
|
|
502 ;;; must still be set to a regular expression matching hosts in your local
|
|
|
503 ;;; domain. efs uses this to determine which machines that it can
|
|
|
504 ;;; open-network-stream to. Furthermore, you should still set
|
|
|
505 ;;; efs-gateway-host to the name of your gateway machine. That way efs
|
|
|
506 ;;; will know that this is a special machine having direct TCP/IP access
|
|
|
507 ;;; to both hosts in the outside world, and hosts in your local domain.
|
|
|
508 ;;;
|
|
|
509 ;;; 8) Common Problems with Gateways:
|
|
|
510 ;;;
|
|
|
511 ;;; a) Spurious 220 responses:
|
|
|
512 ;;; Some proxy-style gateways (eg gateway type 'proxy or 'raptor),
|
|
|
513 ;;; return two 3-digit FTP reply codes to the USER command.
|
|
|
514 ;;; For example:
|
|
|
515 ;;;
|
|
|
516 ;;; open gateway.weird
|
|
|
517 ;;; 220 Connected to gateway.weird
|
|
|
518 ;;; quote USER sandy@foobar
|
|
|
519 ;;; 220 Connected to foobar
|
|
|
520 ;;; 331 Password required for sandy
|
|
|
521 ;;;
|
|
|
522 ;;; This is wrong, according to the FT Protocol. Each command must return
|
|
|
523 ;;; exactly one 3-digit reply code. It may be preceded by continuation
|
|
|
524 ;;; lines. What should really be returned is:
|
|
|
525 ;;;
|
|
|
526 ;;; quote USER sandy@foobar
|
|
|
527 ;;; 331-Connected to foobar.
|
|
|
528 ;;; 331 Password required for sandy.
|
|
|
529 ;;;
|
|
|
530 ;;; or even
|
|
|
531 ;;;
|
|
|
532 ;;; quote USER sandy@foobar
|
|
|
533 ;;; 331-220 Connected to foobar.
|
|
|
534 ;;; 331 Password required for sandy.
|
|
|
535 ;;;
|
|
|
536 ;;; Even though the "331-220" looks strange, it is correct protocol, and
|
|
|
537 ;;; efs will parse it properly.
|
|
|
538 ;;;
|
|
|
539 ;;; If your gateway is returning a spurious 220 to USER, a work-around
|
|
|
540 ;;; is to add a regular expression to `efs-skip-msgs' that matches
|
|
|
541 ;;; this line. It must not match the 220 line returned to the open
|
|
|
542 ;;; command. This work-around may not work, as some system FTP clients
|
|
|
543 ;;; also get confused by the spurious 220. In this case, the only
|
|
|
544 ;;; solution is to patch the gateway server. In either case, please
|
|
|
545 ;;; send a bug report to the author of your gateway software.
|
|
|
546 ;;;
|
|
|
547 ;;; b) Case-sensitive parsing of FTP commands:
|
|
|
548 ;;; Some gateway servers seem to treat FTP commands case-sensitively.
|
|
|
549 ;;; This is incorrect, as RFC 959 clearly states that FTP commands
|
|
|
550 ;;; are always to be case-insensitive. If this is a problem with your
|
|
|
551 ;;; gateway server, you should send a bug report to its author.
|
|
|
552 ;;; If efs is using a case for FTP commands that does not suit your server,
|
|
|
553 ;;; a possible work-around is to edit the efs source so that the required
|
|
|
554 ;;; case is used. However, we will not be making any changes to the
|
|
|
555 ;;; standard efs distribution to support this type of server behaviour.
|
|
|
556 ;;; If you need help changing the efs source, you should enquire with the
|
|
|
557 ;;; efs-help mailing list.
|
|
|
558 ;;;
|
|
|
559
|
|
|
560 ;;; ---------------------------------------------------------------
|
|
|
561 ;;; Tips for using efs:
|
|
|
562 ;;; ---------------------------------------------------------------
|
|
|
563
|
|
|
564 ;;; 1) Beware of compressing files on non-UNIX hosts. efs will do it by
|
|
|
565 ;;; copying the file to the local machine, compressing it there, and then
|
|
|
566 ;;; sending it back. Binary file transfers between machines of different
|
|
|
567 ;;; architectures can be a risky business. Test things out first on some
|
|
|
568 ;;; test files. See "Bugs" below. Also, note that efs sometimes
|
|
|
569 ;;; copies files by moving them through the local machine. Again,
|
|
|
570 ;;; be careful when doing this with binary files on non-Unix
|
|
|
571 ;;; machines.
|
|
|
572 ;;;
|
|
|
573 ;;; 2) Beware that dired over ftp will use your setting of dired-no-confirm
|
|
|
574 ;;; (list of dired commands for which confirmation is not asked).
|
|
|
575 ;;; You might want to reconsider your setting of this variable,
|
|
|
576 ;;; because you might want confirmation for more commands on remote
|
|
|
577 ;;; direds than on local direds. For example, I strongly recommend
|
|
|
578 ;;; that you not include compress in this list. If there is enough
|
|
|
579 ;;; demand it might be a good idea to have an alist
|
|
|
580 ;;; efs-dired-no-confirm of pairs ( TYPE . LIST ), where TYPE is an
|
|
|
581 ;;; operating system type and LIST is a list of commands for which
|
|
|
582 ;;; confirmation would be suppressed. Then remote dired listings
|
|
|
583 ;;; would take their (buffer-local) value of dired-no-confirm from
|
|
|
584 ;;; this alist. Who votes for this?
|
|
|
585 ;;;
|
|
|
586 ;;; 3) Some combinations of FTP clients and servers break and get out of sync
|
|
|
587 ;;; when asked to list a non-existent directory. Some of the ai.mit.edu
|
|
|
588 ;;; machines cause this problem for some FTP clients. Using
|
|
|
589 ;;; efs-kill-ftp-process can be used to restart the ftp process, which
|
|
|
590 ;;; should get things back in synch.
|
|
|
591 ;;;
|
|
|
592 ;;; 4) Some ftp servers impose a length limit on the password that can
|
|
|
593 ;;; be sent. If this limit is exceeded they may bomb in an
|
|
|
594 ;;; incomprehensible way. This sort of behaviour is common with
|
|
|
595 ;;; MVS servers. Therefore, you should beware of this possibility
|
|
|
596 ;;; if you are generating a long password (like an email address)
|
|
|
597 ;;; with efs-generate-anonymous-password.
|
|
|
598 ;;;
|
|
|
599 ;;; 5) Some antiquated FTP servers hang when asked for an RNFR command.
|
|
|
600 ;;; efs sometimes uses this to test whether its local cache is stale.
|
|
|
601 ;;; If your server for HOST hangs when asked for this command, put
|
|
|
602 ;;; (efs-set-host-property HOST 'rnfr-failed t)
|
|
|
603 ;;; in your efs-ftp-startup-function-alist entry for HOST.
|
|
|
604 ;;;
|
|
|
605
|
|
|
606 ;;; -----------------------------------------------------------------------
|
|
|
607 ;;; Where to get the latest version of efs:
|
|
|
608 ;;; -----------------------------------------------------------------------
|
|
|
609 ;;;
|
|
|
610 ;;; The authors are grateful to anyone or any organization which
|
|
|
611 ;;; provides anonymous FTP distribution for efs.
|
|
|
612 ;;;
|
|
|
613 ;;;
|
|
|
614 ;;; Europe:
|
|
|
615 ;;;
|
|
|
616 ;;; Switzerland
|
|
|
617 ;;; /anonymous@itp.ethz.ch:/sandy/efs/
|
|
|
618 ;;;
|
|
|
619 ;;; North America:
|
|
|
620 ;;;
|
|
|
621 ;;; Massachusetts, USA
|
|
|
622 ;;; /anonymous@alpha.gnu.ai.mit.edu:/efs/
|
|
|
623 ;;;
|
|
|
624 ;;; California, USA
|
|
|
625 ;;; /anonymous@ftp.hmc.edu:/pub/emacs/packages/efs/
|
|
|
626 ;;;
|
|
|
627 ;;; Australia and New Zealand:
|
|
|
628 ;;;
|
|
|
629 ;;; ????????????
|
|
|
630 ;;;
|
|
|
631 ;;; Japan:
|
|
|
632 ;;;
|
|
|
633 ;;; ????????????
|
|
|
634
|
|
|
635 ;;; ---------------------------------------------------------------------
|
|
|
636 ;;; Non-UNIX support:
|
|
|
637 ;;; ---------------------------------------------------------------------
|
|
|
638
|
|
|
639 ;;; efs has full support, incuding file name completion and tree dired
|
|
|
640 ;;; for:
|
|
|
641 ;;;
|
|
|
642 ;;; VMS, CMS, MTS, MVS, ti-twenex, ti-explorer (the last two are lisp
|
|
|
643 ;;; machines), TOPS-20, DOS (running the Distinct, Novell, FTP
|
|
|
644 ;;; software, NCSA, Microsoft in both unix and DOS mode, Super TCP, and
|
|
|
645 ;;; Hellsoft FTP servers), unix descriptive listings (dl), KA9Q, OS/2,
|
|
|
646 ;;; VOS, NOS/VE, CMS running the KNET server, Tandem's Guardian OS, COKE
|
|
|
647 ;;;
|
|
|
648 ;;; efs should be able to automatically recognize any of the operating
|
|
|
649 ;;; systems and FTP servers that it supports. Please report any
|
|
|
650 ;;; failure to do so to the "bugs" address below. You can specify a
|
|
|
651 ;;; certain host as being of a given host type with the command
|
|
|
652 ;;;
|
|
|
653 ;;; (efs-add-host <host-type> <host>)
|
|
|
654 ;;;
|
|
|
655 ;;; <host-type> is a symbol, <host> is a string. If this command is
|
|
|
656 ;;; used interactively, then <host-type> is prompted for with
|
|
|
657 ;;; completion. Some host types have regexps that can be used to
|
|
|
658 ;;; specify a class of host names as being of a certain type. Note
|
|
|
659 ;;; that if you specify a host as being of a certain type, efs does
|
|
|
660 ;;; not verify that that is really the type of the host. This calls
|
|
|
661 ;;; for caution when using regexps to specify host types, as an
|
|
|
662 ;;; inadvertent match to a regexp might have unpleasant consequences.
|
|
|
663 ;;;
|
|
|
664 ;;; See the respective efs-TYPE.el files for more information.
|
|
|
665 ;;; When or if we get a tex info file, it should contain some more
|
|
|
666 ;;; details on the non-unix support.
|
|
|
667
|
|
|
668 ;;; ------------------------------------------------------------------
|
|
|
669 ;;; Bugs and other things that go clunk in the night:
|
|
|
670 ;;; ------------------------------------------------------------------
|
|
|
671
|
|
|
672 ;;; How to report a bug:
|
|
|
673 ;;; --------------------
|
|
|
674 ;;;
|
|
|
675 ;;; Type M-x efs-report-bug
|
|
|
676 ;;; or
|
|
|
677 ;;; send mail to efs-bugs@cuckoo.hpl.hp.com.
|
|
|
678 ;;;
|
|
|
679 ;;; efs is a "free" program. This means that you didn't (or shouldn't
|
|
|
680 ;;; have) paid anything for it. It also means that nobody is paid to
|
|
|
681 ;;; maintain it, and the authors weren't paid for writing it.
|
|
|
682 ;;; Therefore, please try to write your bug report in a clear and
|
|
|
683 ;;; complete fashion. It will greatly enhance the probability that
|
|
|
684 ;;; something will be done about your problem.
|
|
|
685 ;;;
|
|
|
686 ;;; Note that efs relies heavily in cached information, so the bug may
|
|
|
687 ;;; depend in a complicated fashion on commands that were performed on
|
|
|
688 ;;; remote files from the beginning of your emacs session. Trying to
|
|
|
689 ;;; reproduce your bug starting from a fresh emacs session is usually
|
|
|
690 ;;; a good idea.
|
|
|
691 ;;;
|
|
|
692
|
|
|
693 ;;; Fan/hate mail:
|
|
|
694 ;;; --------------
|
|
|
695 ;;;
|
|
|
696 ;;; efs has its own mailing list called efs-help. All users of efs
|
|
|
697 ;;; are welcome to subscribe (see below) and to discuss aspects of
|
|
|
698 ;;; efs. New versions of efs are posted periodically to the mailing
|
|
|
699 ;;; list.
|
|
|
700 ;;;
|
|
|
701 ;;; To [un]subscribe to efs-help, or to report mailer problems with the
|
|
|
702 ;;; list, please mail one of the following addresses:
|
|
|
703 ;;;
|
|
|
704 ;;; efs-help-request@cuckoo.hpl.hp.com
|
|
|
705 ;;; or
|
|
|
706 ;;; efs-help-request%cuckoo.hpl.hp.com@hplb.hpl.hp.com
|
|
|
707 ;;;
|
|
|
708 ;;; Please don't forget the -request part.
|
|
|
709 ;;;
|
|
|
710 ;;; For mail to be posted directly to efs-help, send to one of the
|
|
|
711 ;;; following addresses:
|
|
|
712 ;;;
|
|
|
713 ;;; efs-help@cuckoo.hpl.hp.com
|
|
|
714 ;;; or
|
|
|
715 ;;; efs-help%cuckoo.hpl.hp.com@hplb.hpl.hp.com
|
|
|
716 ;;;
|
|
|
717 ;;; Alternatively, there is a mailing list that only gets
|
|
|
718 ;;; announcements of new efs releases. This is called efs-announce,
|
|
|
719 ;;; and can be subscribed to by e-mailing to the -request address as
|
|
|
720 ;;; above. Please make it clear in the request which mailing list you
|
|
|
721 ;;; wish to join.
|
|
|
722 ;;;
|
|
|
723
|
|
|
724 ;;; Known bugs:
|
|
|
725 ;;; -----------
|
|
|
726 ;;;
|
|
|
727 ;;; If you hit a bug in this list, please report it anyway. Most of
|
|
|
728 ;;; the bugs here remain unfixed because they are considered too
|
|
|
729 ;;; esoteric to be a high priority. If one of them gets reported
|
|
|
730 ;;; enough, we will likely change our view on that.
|
|
|
731 ;;;
|
|
|
732 ;;; 1) efs does not check to make sure that when creating a new file,
|
|
|
733 ;;; you provide a valid filename for the remote operating system.
|
|
|
734 ;;; If you do not, then the remote FTP server will most likely
|
|
|
735 ;;; translate your filename in some way. This may cause efs to
|
|
|
736 ;;; get confused about what exactly is the name of the file.
|
|
|
737 ;;;
|
|
|
738 ;;; 2) For CMS support, we send too many cd's. Since cd's are cheap, I haven't
|
|
|
739 ;;; worried about this too much. Eventually, we should have some caching
|
|
|
740 ;;; of the current minidisk. This is complicated by the fact that some
|
|
|
741 ;;; CMS servers lie about the current minidisk, so sending redundant
|
|
|
742 ;;; cd's helps us recover in this case.
|
|
|
743 ;;;
|
|
|
744 ;;; 3) The code to do compression of files over ftp is not as careful as it
|
|
|
745 ;;; should be. It deletes the old remote version of the file, before
|
|
|
746 ;;; actually checking if the local to remote transfer of the compressed
|
|
|
747 ;;; file succeeds. Of course to delete the original version of the file
|
|
|
748 ;;; after transferring the compressed version back is also dangerous,
|
|
|
749 ;;; because some OS's have severe restrictions on the length of filenames,
|
|
|
750 ;;; and when the compressed version is copied back the "-Z" or ".Z" may be
|
|
|
751 ;;; truncated. Then, efs would delete the only remaining version of
|
|
|
752 ;;; the file. Maybe efs should make backups when it compresses files
|
|
|
753 ;;; (of course, the backup "~" could also be truncated off, sigh...).
|
|
|
754 ;;; Suggestions?
|
|
|
755 ;;;
|
|
|
756 ;;; 4) If a dir listing is attempted for an empty directory on (at least
|
|
|
757 ;;; some) VMS hosts, an ftp error is given. This is really an ftp bug, and
|
|
|
758 ;;; I don't know how to get efs work to around it.
|
|
|
759 ;;;
|
|
|
760 ;;; 5) efs gets confused by directories containing file names with
|
|
|
761 ;;; embedded newlines. A temporary solution is to add "q" to your
|
|
|
762 ;;; dired listing switches. As long as your dired listing switches
|
|
|
763 ;;; also contain "l" and either "a" or "A", efs will use these
|
|
|
764 ;;; switches to get listings for its internal cache. The "q" switch
|
|
|
765 ;;; should force listings to be exactly one file per line. You
|
|
|
766 ;;; still will not be able to access a file with embedded newlines,
|
|
|
767 ;;; but at least it won't mess up the parsing of the rest of the files.
|
|
|
768 ;;;
|
|
|
769 ;;; 6) efs cannot parse symlinks which have an embedded " -> "
|
|
|
770 ;;; in their name. It's alright to have an embedded " -> " in the name
|
|
|
771 ;;; of any other type of file. A fix is possible, but probably not worth
|
|
|
772 ;;; the trouble. If you disagree, send us a bug report.
|
|
|
773 ;;;
|
|
|
774 ;;; 7) efs doesn't handle context-dep. files in H-switch listings on
|
|
|
775 ;;; HP's. It wouldn't be such a big roaring deal to fix this. I'm
|
|
|
776 ;;; waiting until I get an actual bug report though.
|
|
|
777 ;;;
|
|
|
778 ;;; 8) If a hard link is added or deleted, efs will not update its
|
|
|
779 ;;; internal cache of the link count for other names of the file.
|
|
|
780 ;;; This may cause file-nlinks to return incorrectly. Reverting
|
|
|
781 ;;; any dired buffer containing other names for the file will
|
|
|
782 ;;; cause the file data to be updated, including the link counts.
|
|
|
783 ;;; A fix for this problem is known and will be eventually
|
|
|
784 ;;; implemented. How it is implemented will depend on how we decide
|
|
|
785 ;;; to handle inodes. See below.
|
|
|
786 ;;;
|
|
|
787 ;;; 9) efs is unable to parse R-switch listings from remote unix hosts.
|
|
|
788 ;;; This is inefficient, because efs will insist on doing individual
|
|
|
789 ;;; listings of the subdirectories to get its file information.
|
|
|
790 ;;; This may be fixed if there is enough demand.
|
|
|
791 ;;;
|
|
|
792 ;;; 10) In file-attributes, efs returns a fake inode number. Of course
|
|
|
793 ;;; this is necessary, but this inode number is not even necessarily
|
|
|
794 ;;; unique. It is simply the sum of the characters (treated as
|
|
|
795 ;;; integers) in the host name, user name, and file name. Possible
|
|
|
796 ;;; ways to get a unique inode number are:
|
|
|
797 ;;; a) Simply keep a count of all remote file in the cache, and
|
|
|
798 ;;; return the file's position in this count as a negative number.
|
|
|
799 ;;; b) For unix systems, we could actually get at the real inode
|
|
|
800 ;;; number on the remote host, by adding an "i" to the ls switches.
|
|
|
801 ;;; The inode numbers would then be removed from the listing
|
|
|
802 ;;; returned by efs-ls, if the caller hadn't requested the "i"
|
|
|
803 ;;; switch. We could then make a unique number out of the host name
|
|
|
804 ;;; and the real inode number.
|
|
|
805 ;;;
|
|
|
806 ;;; 11) efs tries to determine if a file is readable or writable by comparing
|
|
|
807 ;;; the file modes, file owner, and user name under which it is logged
|
|
|
808 ;;; into the remote host. This does not take into account groups.
|
|
|
809 ;;; We simply assume that the user belongs to all groups. As a result
|
|
|
810 ;;; we may assume that a file is writable, when in fact it is not.
|
|
|
811 ;;; Groups are tough to handle correctly over FTP. Suggestions?
|
|
|
812 ;;; (For new FTP servers, can do a "QUOTE SITE EXEC groups" to
|
|
|
813 ;;; handle this.)
|
|
|
814
|
|
|
815 ;;; -----------------------------------------------------------
|
|
|
816 ;;; Technical information on this package:
|
|
|
817 ;;; -----------------------------------------------------------
|
|
|
818
|
|
|
819 ;;; efs hooks onto the following functions using the
|
|
|
820 ;;; file-name-handler-alist. Depending on which version of emacs you
|
|
|
821 ;;; are using, not all of these functions may access this alist. In
|
|
|
822 ;;; this case, efs overloads the definitions of these functions with
|
|
|
823 ;;; versions that do access the file-name-handler-alist. These
|
|
|
824 ;;; overloads are done in efs's version-specific files.
|
|
|
825 ;;;
|
|
|
826 ;;; abbreviate-file-name
|
|
|
827 ;;; backup-buffer
|
|
|
828 ;;; copy-file
|
|
|
829 ;;; create-file-buffer
|
|
|
830 ;;; delete-directory
|
|
|
831 ;;; delete-file
|
|
|
832 ;;; directory-file-name
|
|
|
833 ;;; directory-files
|
|
|
834 ;;; file-attributes
|
|
|
835 ;;; file-directory-p
|
|
|
836 ;;; file-exists-p
|
|
|
837 ;;; file-local-copy
|
|
|
838 ;;; file-modes
|
|
|
839 ;;; file-name-all-completions
|
|
|
840 ;;; file-name-as-directory
|
|
|
841 ;;; file-name-completion
|
|
|
842 ;;; file-name-directory
|
|
|
843 ;;; file-name-nondirectory
|
|
|
844 ;;; file-name-sans-versions
|
|
|
845 ;;; file-newer-than-file-p
|
|
|
846 ;;; file-readable-p
|
|
|
847 ;;; file-executable-p
|
|
|
848 ;;; file-accessible-directory-p
|
|
|
849 ;;; file-symlink-p
|
|
|
850 ;;; file-writable-p
|
|
|
851 ;;; get-file-buffer
|
|
|
852 ;;; insert-directory
|
|
|
853 ;;; insert-file-contents
|
|
|
854 ;;; list-directory
|
|
|
855 ;;; make-directory-internal
|
|
|
856 ;;; rename-file
|
|
|
857 ;;; set-file-modes
|
|
|
858 ;;; set-visited-file-modtime
|
|
|
859 ;;; substitute-in-file-name
|
|
|
860 ;;; verify-visited-file-modtime
|
|
|
861 ;;; write-region
|
|
|
862 ;;;
|
|
|
863 ;;; The following functions are overloaded in efs.el, because they cannot
|
|
|
864 ;;; be handled via the file-name-handler-alist.
|
|
|
865 ;;;
|
|
|
866 ;;; expand-file-name
|
|
|
867 ;;; load
|
|
|
868 ;;; read-file-name-internal (Emacs 18, only)
|
|
|
869 ;;; require
|
|
|
870 ;;;
|
|
|
871 ;;; The following dired functions are handled by hooking them into the
|
|
|
872 ;;; the file-name-handler-alist. This is done in efs-dired.el.
|
|
|
873 ;;;
|
|
|
874 ;;; efs-dired-compress-file
|
|
|
875 ;;; eds-dired-print-file
|
|
|
876 ;;; efs-dired-make-compressed-filename
|
|
|
877 ;;; efs-compress-file
|
|
|
878 ;;; efs-dired-print-file
|
|
|
879 ;;; efs-dired-create-directory
|
|
|
880 ;;; efs-dired-recursive-delete-directory
|
|
|
881 ;;; efs-dired-uncache
|
|
|
882 ;;; efs-dired-call-process
|
|
|
883 ;;;
|
|
|
884 ;;; In efs-dired.el, the following dired finctions are overloaded.
|
|
|
885 ;;;
|
|
|
886 ;;; dired-collect-file-versions
|
|
|
887 ;;; dired-find-file
|
|
|
888 ;;; dired-flag-backup-files
|
|
|
889 ;;; dired-get-filename
|
|
|
890 ;;; dired-insert-headerline
|
|
|
891 ;;; dired-move-to-end-of-filename
|
|
|
892 ;;; dired-move-to-filename
|
|
|
893 ;;; dired-run-shell-command
|
|
|
894 ;;;
|
|
|
895 ;;; efs makes use of the following hooks
|
|
|
896 ;;;
|
|
|
897 ;;; diff-load-hook
|
|
|
898 ;;; dired-before-readin-hook
|
|
|
899 ;;; find-file-hooks
|
|
|
900 ;;; dired-grep-load-hook
|
|
|
901
|
|
|
902 ;;; LISPDIR ENTRY for the Elisp Archive:
|
|
|
903 ;;;
|
|
|
904 ;;; LCD Archive Entry:
|
|
|
905 ;;; efs|Andy Norman and Sandy Rutherford
|
|
|
906 ;;; |ange@hplb.hpl.hp.com and sandy@ibm550.sissa.it
|
|
|
907 ;;; |transparent FTP Support for GNU Emacs
|
|
|
908 ;;; |$Date: 1997/02/15 22:20:36 $|$efs release: 1.15 beta $|
|
|
|
909
|
|
|
910 ;;; Host and listing type notation:
|
|
|
911 ;;;
|
|
|
912 ;;; The functions efs-host-type and efs-listing-type, and the
|
|
|
913 ;;; variable efs-dired-host-type follow the following conventions
|
|
|
914 ;;; for remote host types.
|
|
|
915 ;;;
|
|
|
916 ;;; nil = local host type, whatever that is (probably unix).
|
|
|
917 ;;; Think nil as in "not a remote host". This value is used by
|
|
|
918 ;;; efs-dired-host-type for local buffers.
|
|
|
919 ;;; (efs-host-type nil) => nil
|
|
|
920 ;;;
|
|
|
921 ;;; 'type = a remote host of TYPE type.
|
|
|
922 ;;;
|
|
|
923 ;;; 'type:list = a remote host using listing type 'type:list.
|
|
|
924 ;;; This is currently used for Unix dl (descriptive
|
|
|
925 ;;; listings), when efs-dired-host-type is set to
|
|
|
926 ;;; 'unix:dl, and to support the myriad of DOS FTP
|
|
|
927 ;;; servers.
|
|
|
928
|
|
|
929 ;;; Supported host and listing types:
|
|
|
930 ;;;
|
|
|
931 ;;; unknown, unix, dumb-unix, bsd-unix, sysV-unix, next-unix,
|
|
|
932 ;;; super-dumb-unix, dumb-apollo-unix,
|
|
|
933 ;;; apollo-unix, unix:dl, dos-distinct, ka9q, dos, dos:ftp, dos:novell,
|
|
|
934 ;;; dos:ncsa, dos:winsock, vos, hell, dos:microsoft, super-dumb-unix
|
|
|
935 ;;; vms, cms, mts, mvs, mvs:tcp mvs:nih tops-20, mpe, ti-twenex,
|
|
|
936 ;;; ti-explorer, os2, vos,
|
|
|
937 ;;; vms:full, guardian, ms-unix (This is the Microsoft NT Windows server
|
|
|
938 ;;; in unix mode.), plan9, unix:unknown, nos-ve (actually NOS/VE).
|
|
|
939
|
|
|
940 ;;; Host and listing type hierarchy:
|
|
|
941 ;;;
|
|
|
942 ;;; unknown: unix, dumb-unix, sysV-unix, bsd-unix, next-unix, apollo-unix,
|
|
|
943 ;;; ka9q, dos-distinct, unix:dl, hell,
|
|
|
944 ;;; super-dumb-unix, dumb-apollo-unix
|
|
|
945 ;;; unix: sysV-unix, bsd-unix, next-unix, apollo-unix, unix:dl
|
|
|
946 ;;; dos: dos:ftp, dos:novell, dos:ncsa, dos:microsoft, dos:winsock
|
|
|
947 ;;; dumb-unix:
|
|
|
948 ;;; bsd-unix:
|
|
|
949 ;;; sysV-unix:
|
|
|
950 ;;; next-unix:
|
|
|
951 ;;; apollo-unix:
|
|
|
952 ;;; dumb-apollo-unix:
|
|
|
953 ;;; unix:dl:
|
|
|
954 ;;; unix:unknown: unix:dl, unix
|
|
|
955 ;;; super-dumb-unix:
|
|
|
956 ;;; dos-distinct:
|
|
|
957 ;;; dos:ftp:
|
|
|
958 ;;; dos:novell:
|
|
|
959 ;;; dos:microsoft
|
|
|
960 ;;; ka9q:
|
|
|
961 ;;; vms: vms:full
|
|
|
962 ;;; cms:
|
|
|
963 ;;; mts:
|
|
|
964 ;;; mvs: mvs:tcp, mvs:nih
|
|
|
965 ;;; mvs:tcp:
|
|
|
966 ;;; mvs:nih:
|
|
|
967 ;;; tops-20:
|
|
|
968 ;;; ti-twenex:
|
|
|
969 ;;; ti-explorer:
|
|
|
970 ;;; os2:
|
|
|
971 ;;; vos:
|
|
|
972 ;;; vms:full:
|
|
|
973 ;;; dos:ncsa:
|
|
|
974 ;;; dos:winsock:
|
|
|
975 ;;; vos:
|
|
|
976 ;;; hell:
|
|
|
977 ;;; guardian:
|
|
|
978 ;;; ms-unix:
|
|
|
979 ;;; plan9:
|
|
|
980 ;;; nos-ve:
|
|
|
981 ;;; coke:
|
|
|
982 ;;;
|
|
|
983
|
|
|
984
|
|
|
985 ;;;; ================================================================
|
|
|
986 ;;;; >0
|
|
|
987 ;;;; Table of Contents for efs.el
|
|
|
988 ;;;; ================================================================
|
|
|
989 ;;
|
|
|
990 ;; Each section of efs.el is labelled by >#, where # is the number of
|
|
|
991 ;; the section.
|
|
|
992 ;;
|
|
|
993 ;; 1. Provisions, requirements, and autoloads.
|
|
|
994 ;; 2. Variable definitions.
|
|
|
995 ;; 3. Utilities.
|
|
|
996 ;; 4. Hosts, users, accounts, and passwords.
|
|
|
997 ;; 5. FTP client process and server responses.
|
|
|
998 ;; 6. Sending commands to the FTP server.
|
|
|
999 ;; 7. Parsing and storing remote file system data.
|
|
|
1000 ;; 8. Redefinitions of standard GNU Emacs functions.
|
|
|
1001 ;; 9. Multiple host type support.
|
|
|
1002 ;; 10. Attaching onto the appropriate emacs version.
|
|
|
1003
|
|
|
1004
|
|
|
1005 ;;;; ================================================================
|
|
|
1006 ;;;; >1
|
|
|
1007 ;;;; General provisions, requirements, and autoloads.
|
|
|
1008 ;;;; Host type, and local emacs type dependent loads, and autoloads
|
|
|
1009 ;;;; are in the last two sections of this file.
|
|
|
1010 ;;;; ================================================================
|
|
|
1011
|
|
|
1012 ;;;; ----------------------------------------------------------------
|
|
|
1013 ;;;; Provide the package (Do this now to avoid an infinite loop)
|
|
|
1014 ;;;; ----------------------------------------------------------------
|
|
|
1015
|
|
|
1016 (provide 'efs)
|
|
|
1017
|
|
|
1018 ;;;; ----------------------------------------------------------------
|
|
|
1019 ;;;; Our requirements.
|
|
|
1020 ;;;; ----------------------------------------------------------------
|
|
|
1021
|
|
|
1022 (require 'backquote)
|
|
|
1023 (require 'comint)
|
|
|
1024 (require 'efs-defun)
|
|
|
1025 (require 'efs-netrc)
|
|
|
1026 (require 'efs-cu)
|
|
|
1027 (require 'efs-ovwrt)
|
|
|
1028 ;; Do this last, as it installs efs into the file-name-handler-alist.
|
|
|
1029 (require 'efs-fnh)
|
|
|
1030
|
|
|
1031 (autoload 'efs-report-bug "efs-report" "Submit a bug report for efs." t)
|
|
|
1032 (autoload 'efs-gwp-start "efs-gwp" ; For interactive gateways.
|
|
|
1033 "Login to the gateway machine and fire up an FTP client.")
|
|
|
1034 (autoload 'efs-kerberos-login "efs-kerberos")
|
|
|
1035 (autoload 'efs-insert-directory "efs-dired" "Insert a directory listing.")
|
|
|
1036 (autoload 'efs-set-mdtm-of "efs-cp-p")
|
|
|
1037 (autoload 'diff-latest-backup-file "diff")
|
|
|
1038 (autoload 'read-passwd "passwd" "Read a password from the minibuffer." t)
|
|
|
1039
|
|
|
1040
|
|
|
1041 ;;;; ============================================================
|
|
|
1042 ;;;; >2
|
|
|
1043 ;;;; Variable Definitions
|
|
|
1044 ;;;; **** The user configuration variables are in ****
|
|
|
1045 ;;;; **** the second subsection of this section. ****
|
|
|
1046 ;;;; ============================================================
|
|
|
1047
|
|
|
1048 ;;;; ------------------------------------------------------------
|
|
|
1049 ;;;; Constant Definitions
|
|
|
1050 ;;;; ------------------------------------------------------------
|
|
|
1051
|
|
|
1052 (defconst efs-version
|
|
|
1053 (concat (substring "$efs release: 1.15 $" 14 -2)
|
|
|
1054 "/"
|
|
|
1055 (substring "$Revision: 1.2 $" 11 -2)))
|
|
|
1056
|
|
|
1057 (defconst efs-time-zero 1970) ; we count time from midnight, Jan 1, 1970 GMT.
|
|
|
1058
|
|
|
1059 (defconst efs-dumb-host-types
|
|
|
1060 '(dumb-unix super-dumb-unix vms cms mts ti-twenex ti-explorer dos mvs
|
|
|
1061 tops-20 mpe ka9q dos-distinct os2 vos hell guardian
|
|
|
1062 netware cms-knet nos-ve coke dumb-apollo-unix)
|
|
|
1063 "List of host types that can't take UNIX ls-style listing options.")
|
|
|
1064 ;; dos-distinct only ignores ls switches; it doesn't barf.
|
|
|
1065 ;; Still treat it as dumb.
|
|
|
1066
|
|
|
1067 (defconst efs-unix-host-types
|
|
|
1068 '(unix sysV-unix bsd-unix next-unix apollo-unix dumb-unix
|
|
|
1069 dumb-apollo-unix super-dumb-unix)
|
|
|
1070 "List of unix host types.")
|
|
|
1071
|
|
|
1072 (defconst efs-version-host-types '(vms tops-20 ti-twenex ti-explorer)
|
|
|
1073 "List of host-types which associated a version number to all files.
|
|
|
1074 This is not the same as associating version numbers to only backup files.")
|
|
|
1075 ;; Note that on these systems,
|
|
|
1076 ;; (file-name-sans-versions EXISTING-FILE) does not exist as a file.
|
|
|
1077
|
|
|
1078 (defconst efs-single-extension-host-types
|
|
|
1079 '(vms tops-20 ti-twenex ti-explorer cms mvs dos ka9q dos-distinct hell
|
|
|
1080 netware ms-unix plan9 cms-knet nos-ve)
|
|
|
1081 "List of host types which allow at most one extension on a file name.
|
|
|
1082 Extensions are deliminated by \".\". In addition, these host-types must
|
|
|
1083 allow \"-\" in file names, because it will be used to add additional extensions
|
|
|
1084 to indicate compressed files.")
|
|
|
1085
|
|
|
1086 (defconst efs-idle-host-types
|
|
|
1087 (append '(coke unknown) efs-unix-host-types))
|
|
|
1088 ;; List of host types for which it is possible that the SITE IDLE command
|
|
|
1089 ;; is supported.
|
|
|
1090
|
|
|
1091 (defconst efs-listing-types
|
|
|
1092 '(unix:dl unix:unknown
|
|
|
1093 dos:novell dos:ftp dos:ncsa dos:microsoft dos:stcp dos:winsock
|
|
|
1094 mvs:nih mvs:tcp mvs:tcp
|
|
|
1095 vms:full)
|
|
|
1096 "List of supported listing types")
|
|
|
1097
|
|
|
1098 (defconst efs-nlist-listing-types
|
|
|
1099 '(vms:full))
|
|
|
1100 ;; Listing types which give a long useless listing when asked for a
|
|
|
1101 ;; LIST. For these, use an NLST instead. This can only be done
|
|
|
1102 ;; when there is some way to distinguish directories from
|
|
|
1103 ;; plain files in an NLST.
|
|
|
1104
|
|
|
1105 (defconst efs-opaque-gateways '(remsh interactive))
|
|
|
1106 ;; List of gateway types for which we need to do explicit file handling on
|
|
|
1107 ;; the gateway machine.
|
|
|
1108
|
|
|
1109 ;;;; ------------------------------------------------------------------
|
|
|
1110 ;;;; User customization variables. Please read through these carefully.
|
|
|
1111 ;;;; ------------------------------------------------------------------
|
|
|
1112
|
|
|
1113 ;;;>>>> If you are not fully connected to the internet, <<<<
|
|
|
1114 ;;;>>>> and need to use a gateway (no matter how transparent) <<<<
|
|
|
1115 ;;;>>>> you will need to set some of the following variables. <<<<
|
|
|
1116 ;;;>>>> Read the documentation carefully. <<<<
|
|
|
1117
|
|
|
1118 (defvar efs-local-host-regexp ".*"
|
|
|
1119 "Regexp to match names of local hosts.
|
|
|
1120 These are hosts to which it is possible to obtain a direct internet
|
|
|
1121 connection. Even if the host is accessible by a very transparent FTP gateway,
|
|
|
1122 it does not qualify as a local host. The test to determine if machine A is
|
|
|
1123 local to your machine is if it is possible to ftp from A _back_ to your
|
|
|
1124 local machine. Also, open-network-stream must be able to reach the host
|
|
|
1125 in question.")
|
|
|
1126
|
|
|
1127 (defvar efs-ftp-local-host-regexp ".*"
|
|
|
1128 "Regexp to match the names of hosts reachable by a direct ftp connection.
|
|
|
1129 This regexp should match the names of hosts which can be reached using ftp,
|
|
|
1130 without requiring any explicit connection to a gateway. If you have a smart
|
|
|
1131 ftp client which is able to transparently go through a gateway, this will
|
|
|
1132 differ from `efs-local-host-regexp'.")
|
|
|
1133
|
|
|
1134 (defvar efs-gateway-host nil
|
|
|
1135 "If non-nil, this must be the name of your ftp gateway machine.
|
|
|
1136 If your net world is divided into two domains according to
|
|
|
1137 `efs-local-ftp-host-regexp', set this variable to the name of the
|
|
|
1138 gateway machine.")
|
|
|
1139
|
|
|
1140 (defvar efs-gateway-type nil
|
|
|
1141 "Specifies which type of gateway you wish efs to use.
|
|
|
1142 This should be a list, the first element of which is a symbol denoting the
|
|
|
1143 gateway type, and following elements give data on how to use the gateway.
|
|
|
1144
|
|
|
1145 The following possibilities are supported:
|
|
|
1146
|
|
|
1147 '(local FTP-PROGRAM FTP-PROGRAM-ARGS)
|
|
|
1148 This means that your local host is itself the gateway. However,
|
|
|
1149 you need to run a special FTP client to access outside hosts.
|
|
|
1150 FTP-PROGRAM should be the name of this FTP client, and FTP-PROGRAM-ARGS
|
|
|
1151 is a list of arguments to pass to it \(probably set this to the value of
|
|
|
1152 efs-ftp-program-args <V>\). Note that if your gateway is of this type,
|
|
|
1153 then you would set efs-gateway-host to nil.
|
|
|
1154
|
|
|
1155 '(proxy FTP-PROGRAM FTP-PROGRAM-ARGS)
|
|
|
1156 This indicates that your gateway works by first FTP'ing to it, and
|
|
|
1157 then giving a USER command of the form \"USER <username>@<host>\".
|
|
|
1158 FTP-PROGRAM is the FTP program to use to connect to the gateway; this
|
|
|
1159 is most likely \"ftp\". FTP-PROGRAM-ARGS is a list of arguments to
|
|
|
1160 pass to it. You likely want this to be set to the value of
|
|
|
1161 efs-ftp-program-args <V>. If the connection to the gateway FTP server
|
|
|
1162 is to be on a port different from 21, set efs-gateway-host to
|
|
|
1163 \"<host>#<port>\".
|
|
|
1164
|
|
|
1165 '(raptor FTP-PROGRAM FTP-PROGRAM-ARGS USER)
|
|
|
1166 This is for the gateway called raptor by Eagle. After connecting to the
|
|
|
1167 the gateway, the command \"user <user>@host USER\" is issued to login
|
|
|
1168 as <user> on <host>, where USER is an authentication username for the
|
|
|
1169 gateway. After issuing the password for the remote host, efs will
|
|
|
1170 send the password for USER on efs-gateway-host <V> as an account command.
|
|
|
1171
|
|
|
1172 '(interlock FTP-PROGRAM FTP-PROGRAM-ARGS)
|
|
|
1173 This is for the interlock gateway. The exact login sequence is to
|
|
|
1174 connect to the gateway specified by efs-gateway-host <V>, send the
|
|
|
1175 gateway password with a PASS command, send the command
|
|
|
1176 \"user <user>@<host>\" to connect to remote host <host> as user <user>,
|
|
|
1177 and finally to send the password for <user> on <host> with a second
|
|
|
1178 PASS command.
|
|
|
1179
|
|
|
1180 '(kerberos FTP-PROGRAM FTP-PROGRAM-ARGS KINIT-PROGRAM KINIT-PROGRAM-ARGS)
|
|
|
1181 This is for the kerberos gateway where you need to run a program (kinit) to
|
|
|
1182 obtain a ticket for gateway authroization first. FTP-PROGRAM should be
|
|
|
1183 the name of the FTP client that you use to connect to the gateway. This
|
|
|
1184 may likely be \"iftp\". FTP-PROGRAM-ARGS are the arguments that you need
|
|
|
1185 to pass to FTP-PROGRAM. This is probably the value of
|
|
|
1186 efs-ftp-program-args <V>. KINIT-PROGRAM is the name of the program to
|
|
|
1187 run in order to obtain a ticket. This is probably \"kinit\".
|
|
|
1188 KINIT-PROGRAM-ARGS is a list og strings indicating any arguments that you
|
|
|
1189 need to pass to KINIT-PROGRAM. Most likely this is nil.
|
|
|
1190
|
|
|
1191 '(remsh GATEWAY-PROGRAM GATEWAY-PROGRAM-ARGS FTP-PROGRAM FTP-PROGRAM-ARGS)
|
|
|
1192 This indicates that you wish to run FTP on your gateway using a remote shell.
|
|
|
1193 GATEWAY-PROGRAM is the name of the program to use to start a remote shell.
|
|
|
1194 It is assumed that it is not necessary to provide a password to start
|
|
|
1195 this remote shell. Likely values are \"remsh\" or \"rsh\".
|
|
|
1196 GATEWAY-PROGRAM-ARGS is a list of arguments to pass to GATEWAY-PROGRAM.
|
|
|
1197 FTP-PROGRAM is the name of the FTP program on the gateway. A likely setting
|
|
|
1198 of this is \"ftp\". FTP-PROGRAM-ARGS is a list of arguments to pass to
|
|
|
1199 FTP-PROGRAM. Most likely these should be set to the value of
|
|
|
1200 efs-ftp-program-args <V>.
|
|
|
1201
|
|
|
1202 '(interactive GATEWAY-PROGRAM GATEWAY-PROGRAM-ARGS FTP-PROGRAM
|
|
|
1203 FTP-PROGRAM-ARGS)
|
|
|
1204 This indicates that you need to start an interactive login on your gatway,
|
|
|
1205 using rlogin, telnet, or something similar. GATEWAY-PROGRAM is the name
|
|
|
1206 of the program to use to log in to the gateway, and GATEWAY-PROGRAM-ARGS
|
|
|
1207 is a list of arguments to pass to it. FTP-PROGRAM is the name of the FTP
|
|
|
1208 program on the gateway. A likely setting for this variable would be
|
|
|
1209 \"exec ftp\". FTP-PROGRAM-ARGS is a list of arguments to pass
|
|
|
1210 to FTP-PROGRAM. You probably want to set these to the same value as
|
|
|
1211 efs-ftp-program-args <V>. If you are using this option, read the
|
|
|
1212 documentation at the top of efs-gwp.el, and see
|
|
|
1213 efs-gwp-setup-term-command <V>.")
|
|
|
1214
|
|
|
1215 (defvar efs-gateway-hash-mark-size nil
|
|
|
1216 "*Value of `efs-hash-mark-size' for FTP clients on `efs-gateway-host'.
|
|
|
1217 See the documentation of these variables for more information.")
|
|
|
1218
|
|
|
1219 (defvar efs-gateway-incoming-binary-hm-size nil
|
|
|
1220 "*Value of `efs-incoming-binary-hm-size' for `efs-gateway-host'.
|
|
|
1221 See documentation of these variables for more information.")
|
|
|
1222
|
|
|
1223 (defvar efs-gateway-tmp-name-template "/tmp/efs"
|
|
|
1224 "Template used to create temporary files when ftp-ing through a gateway.
|
|
|
1225 This should be the name of the file on the gateway, and not necessarily
|
|
|
1226 the name on the local host.")
|
|
|
1227
|
|
|
1228 (defvar efs-gateway-mounted-dirs-alist nil
|
|
|
1229 "An alist of directories cross-mounted between the gateway and local host.
|
|
|
1230 Each entry is of the form \( DIR1 . DIR2 \), where DIR1 is the name of the
|
|
|
1231 directory on the local host, and DIR2 is its name on the remote host. Both
|
|
|
1232 DIR1 and DIR2 must be specified in directory syntax, i.e. end in a slash.
|
|
|
1233 Note that we will assume that subdirs of DIR1 and DIR2 are also accessible
|
|
|
1234 on both machines.")
|
|
|
1235
|
|
|
1236 (defvar efs-gateway-ftp-prompt-regexp "^\\(ftp\\|Ftp\\|FTP\\)> *"
|
|
|
1237 "*Regular expression to match the prompt of the gateway FTP client.")
|
|
|
1238
|
|
|
1239 ;;; End of gateway config variables.
|
|
|
1240
|
|
|
1241 (defvar efs-tmp-name-template "/tmp/efs"
|
|
|
1242 "Template used to create temporary files.
|
|
|
1243 If you are worried about security, make this a directory in some
|
|
|
1244 bomb-proof cave somewhere. efs does clean up its temp files, but
|
|
|
1245 they do live for short periods of time.")
|
|
|
1246
|
|
|
1247 (defvar efs-generate-anonymous-password t
|
|
|
1248 "*If t, use a password of `user@host' when logging in as the anonymous user.
|
|
|
1249 `host' is generated by the function `efs-system-fqdn'. If `system name' returns
|
|
|
1250 a fully qualified domain name, `efs-system-fqdn' will return this. Otherwise,
|
|
|
1251 it will attempt to use nslookup to obtain a fully qualified domain name. If
|
|
|
1252 this is unsuccessful, the returned value will be the same as `system-name',
|
|
|
1253 whether this is a fully qualified domain name or not.
|
|
|
1254
|
|
|
1255 If a string then use that as the password.
|
|
|
1256
|
|
|
1257 If nil then prompt the user for a password.
|
|
|
1258
|
|
|
1259 Beware that some operating systems, such as MVS, restrict substantially
|
|
|
1260 the password length. The login will fail with a weird error message
|
|
|
1261 if you exceed it.")
|
|
|
1262
|
|
|
1263 (defvar efs-high-security-hosts nil
|
|
|
1264 "*Indicates host user pairs for which passwords should not be cached.
|
|
|
1265 If non-nil, should be a regexp matching user@host constructions for which
|
|
|
1266 efs should not store passwords in its internal cache.")
|
|
|
1267
|
|
|
1268 ;; The following regexps are tested in the following order:
|
|
|
1269 ;; efs-binary-file-host-regexp, efs-36-bit-binary-file-name-regexp,
|
|
|
1270 ;; efs-binary-file-name-regexp, efs-text-file-name-regexp.
|
|
|
1271 ;; File names which match nothing are transferred in 'image mode.
|
|
|
1272
|
|
|
1273 ;; If we're not careful, we're going to blow the regexp stack here.
|
|
|
1274 ;; Probably should move to a list of regexps. Slower, but safer.
|
|
|
1275 ;; This is not a problem in Emacs 19.
|
|
|
1276 (defvar efs-binary-file-name-regexp
|
|
|
1277 (concat "\\." ; the dot
|
|
|
1278 ;; extensions
|
|
|
1279 "\\([zZ]\\|t?gz\\|lzh\\|arc\\|zip\\|zoo\\|ta[rz]\\|dvi\\|sit\\|"
|
|
|
1280 "ps\\|elc\\|gif\\|Z-part-..\\|tpz\\|exe\\|[jm]pg\\|TZ[a-z]?\\|lib\\)"
|
|
|
1281 "\\(~\\|~[0-9]+~\\)?$" ; backups
|
|
|
1282 "\\|"
|
|
|
1283 ;; UPPER CASE LAND
|
|
|
1284 "\\."
|
|
|
1285 "\\(ARC\\|ELC\\|TAGS\\|EXE\\|ZIP\\|DVI\|ZOO\\|GIF\\|T?GZ\\|"
|
|
|
1286 "[JM]PG\\)"
|
|
|
1287 "\\([.#;][0-9]+\\)?$" ; versions
|
|
|
1288 )
|
|
|
1289 "*Files whose names match this regexp will be considered to be binary.
|
|
|
1290 By binary here, we mean 8-bit binary files (the usual unix binary files).
|
|
|
1291 If nil, no files will be considered to be binary.")
|
|
|
1292
|
|
|
1293 (defvar efs-binary-file-host-regexp nil
|
|
|
1294 "*All files on hosts matching this regexp are treated as 8-bit binary.
|
|
|
1295 Setting this to nil, inhibits this feature.")
|
|
|
1296
|
|
|
1297 (defvar efs-36-bit-binary-file-name-regexp nil
|
|
|
1298 "*Files whose names match this regexp will be considered to PDP 10 binaries.
|
|
|
1299 These are 36-bit word-aligned binary files. This is really only relevant for
|
|
|
1300 files on PDP 10's, and similar machines. If nil, no files will be considered
|
|
|
1301 to be PDP 10 binaries.")
|
|
|
1302
|
|
|
1303 (defvar efs-text-file-name-regexp ".*"
|
|
|
1304 "*Files whose names match this regexp will be considered to be text files.")
|
|
|
1305
|
|
|
1306 (defvar efs-prompt-for-transfer-type nil
|
|
|
1307 "*If non-nil, efs will prompt for the transfer type for each file transfer.
|
|
|
1308 The command efs-prompt-for-transfer-type can be used to toggle its value.")
|
|
|
1309
|
|
|
1310 (defvar efs-treat-crlf-as-nl nil
|
|
|
1311 "*Controls how file systems using CRLF as end of line are treated.
|
|
|
1312 If non-nil, such file systems will be considered equivalent to those which use
|
|
|
1313 LF as end of line. This is particularly relevant to transfers between DOS
|
|
|
1314 systems and UNIX. Setting this to be non-nil will cause all file transfers
|
|
|
1315 between DOS and UNIX systems to use be image or binary transfers.")
|
|
|
1316
|
|
|
1317 (defvar efs-send-hash t
|
|
|
1318 "*If non-nil, send the HASH command to the FTP client.")
|
|
|
1319
|
|
|
1320 (defvar efs-hash-mark-size nil
|
|
|
1321 "*Default size, in bytes, between hash-marks when transferring a file.
|
|
|
1322 If this is nil then efs will attempt to assign a value based on the
|
|
|
1323 output of the HASH command. Also, if this variable is incorrectly set,
|
|
|
1324 then efs will try to correct it based on the size of the last file
|
|
|
1325 transferred, and the number hashes outputed by the client during the
|
|
|
1326 transfer.
|
|
|
1327
|
|
|
1328 The variable `efs-gateway-hash-mark-size' defines the corresponding value
|
|
|
1329 for the FTP client on the gateway, if you are using a gateway.
|
|
|
1330
|
|
|
1331 Some client-server combinations do not correctly compute the number of hash
|
|
|
1332 marks for incoming binary transfers. In this case, a separate variable
|
|
|
1333 `efs-incoming-binary-hm-size' can be used to set a default value of the
|
|
|
1334 hash mark size for incoming binary transfers.")
|
|
|
1335
|
|
|
1336 (defvar efs-incoming-binary-hm-size nil
|
|
|
1337 "*Default hash mark size for incoming binary transfers.
|
|
|
1338 If this is nil, incoming binary transfers will use `efs-hash-mark-size' as
|
|
|
1339 the default. See the documentation of this variable for more details.")
|
|
|
1340
|
|
|
1341 (defvar efs-verbose t
|
|
|
1342 "*If non-NIL then be chatty about interaction with the FTP process.
|
|
|
1343 If 0 do not give % transferred reports for asynchronous commands and status
|
|
|
1344 reports for commands verifying file modtimes, but report on everything else.")
|
|
|
1345
|
|
|
1346 (defvar efs-message-interval 0
|
|
|
1347 "*Defines the minimum time in seconds between status messages.
|
|
|
1348 A new status message is not displayed, if one has already been given
|
|
|
1349 within this period of time.")
|
|
|
1350
|
|
|
1351 (defvar efs-max-ftp-buffer-size 3000
|
|
|
1352 "*Maximum size in characters of FTP process buffer, before it is trimmed.
|
|
|
1353 The buffer is trimmed to approximately half this size. Setting this to nil
|
|
|
1354 inhibits trimming of FTP process buffers.")
|
|
|
1355
|
|
|
1356 (defvar efs-ls-cache-max 5
|
|
|
1357 "*Maximum number of directory listings to be cached in efs-ls-cache.")
|
|
|
1358
|
|
|
1359 (defvar efs-mode-line-format " ftp(%d)"
|
|
|
1360 "Format string used to determine how FTP activity is shown on the mode line.
|
|
|
1361 It is passed to format, with second argument the number of active FTP
|
|
|
1362 sessions as an integer.")
|
|
|
1363
|
|
|
1364 (defvar efs-show-host-type-in-dired t
|
|
|
1365 "If non-nil, show the system type on the mode line of remote dired buffers.")
|
|
|
1366
|
|
|
1367 (defvar efs-ftp-activity-function nil
|
|
|
1368 "Function called to indicate FTP activity.
|
|
|
1369 It must have exactly one argument, the number of active FTP sessions as an
|
|
|
1370 integer.")
|
|
|
1371
|
|
|
1372 (defvar efs-ftp-program-name "ftp"
|
|
|
1373 "Name of FTP program to run.")
|
|
|
1374
|
|
|
1375 (defvar efs-ftp-program-args '("-i" "-n" "-g" "-v")
|
|
|
1376 "*A list of arguments passed to the FTP program when started.")
|
|
|
1377
|
|
|
1378 (defvar efs-ftp-prompt-regexp "^\\(ftp\\|Ftp\\|FTP\\)> *"
|
|
|
1379 "*Regular expression to match the prompt of your FTP client.")
|
|
|
1380
|
|
|
1381 (defvar efs-nslookup-program "nslookup"
|
|
|
1382 "*If non-NIL then a string naming nslookup program." )
|
|
|
1383
|
|
|
1384 (defvar efs-nslookup-on-connect nil
|
|
|
1385 "*If non-NIL then use nslookup to resolve the host name before connecting.")
|
|
|
1386
|
|
|
1387 (defvar efs-nslookup-threshold 1000
|
|
|
1388 "How many iterations efs waits on the nslookup program.
|
|
|
1389 Applies when nslookup is used to compute a fully qualified domain name
|
|
|
1390 for the local host, in the case when `system-name' does not return one.
|
|
|
1391 If you set this to nil, efs will wait an arbitrary amount of time to get
|
|
|
1392 output.")
|
|
|
1393
|
|
|
1394 (defvar efs-make-backup-files efs-unix-host-types
|
|
|
1395 "*A list of operating systems for which efs will make Emacs backup files.
|
|
|
1396 The backup files are made on the remote host.
|
|
|
1397
|
|
|
1398 For example:
|
|
|
1399 '\(unix sysV-unix bsd-unix apollo-unix dumb-unix\) makes sense, but
|
|
|
1400 '\(unix vms\) would be silly, since vms makes its own backups.")
|
|
|
1401
|
|
|
1402 ;; Is this variable really useful? We should try to figure a way to
|
|
|
1403 ;; do local copies on a remote machine that doesn't take forever.
|
|
|
1404 (defvar efs-backup-by-copying nil
|
|
|
1405 "*Version of `backup by copying' for remote files.
|
|
|
1406 If non-nil, remote files will be backed up by copying, instead of by renaming.
|
|
|
1407 Note the copying will be done by moving the file through the local host -- a
|
|
|
1408 very time consuming operation.")
|
|
|
1409
|
|
|
1410 ;;; Auto-save variables. Relevant for auto-save.el
|
|
|
1411
|
|
|
1412 (defvar efs-auto-save 0
|
|
|
1413 "*If 1, allows efs files to be auto-saved.
|
|
|
1414 If 0, suppresses auto-saving of efs files.
|
|
|
1415 Don't use any other value.")
|
|
|
1416
|
|
|
1417 (defvar efs-auto-save-remotely nil
|
|
|
1418 "*Determines where remote files are auto-saved.
|
|
|
1419
|
|
|
1420 If nil, auto-saves for remote files will be written in `auto-save-directory'
|
|
|
1421 or `auto-save-directory-fallback' if this isn't defined.
|
|
|
1422
|
|
|
1423 If non-nil, causes the auto-save file for an efs file to be written in
|
|
|
1424 the remote directory containing the file, rather than in a local directory.
|
|
|
1425 For remote files, this overrides a non-nil `auto-save-directory'. Local files
|
|
|
1426 are unaffected. If you want to use this feature, you probably only want to
|
|
|
1427 set this true in a few buffers, rather than globally. You might want to give
|
|
|
1428 each buffer its own value using `make-variable-buffer-local'. It is usually
|
|
|
1429 a good idea to auto-save remote files locally, because it is not only faster,
|
|
|
1430 but provides protection against a connection going down.
|
|
|
1431
|
|
|
1432 See also variable `efs-auto-save'.")
|
|
|
1433
|
|
|
1434 (defvar efs-short-circuit-to-remote-root nil
|
|
|
1435 "*Defines whether \"//\" short-circuits to the remote or local root.")
|
|
|
1436
|
|
|
1437 ;; Can we somehow grok this from system type? No.
|
|
|
1438 (defvar efs-local-apollo-unix
|
|
|
1439 (eq 0 (string-match "//" (or (getenv "HOME") (getenv "SHELL") "")))
|
|
|
1440 "*Defines whether the local machine is an apollo running Domain.
|
|
|
1441 This variable has nothing to do with efs, and should be basic to all
|
|
|
1442 of emacs.")
|
|
|
1443
|
|
|
1444 (defvar efs-root-umask nil
|
|
|
1445 "*umask to use for root logins.")
|
|
|
1446
|
|
|
1447 (defvar efs-anonymous-umask nil
|
|
|
1448 "*umask to use for anonymous logins.")
|
|
|
1449
|
|
|
1450 (defvar efs-umask nil
|
|
|
1451 "*umask to use for efs sessions.
|
|
|
1452 If this is nil, then the setting of umask on the local host is used.")
|
|
|
1453
|
|
|
1454 ;; Eliminate these variables when Sun gets around to getting its FTP server
|
|
|
1455 ;; out of the stone age.
|
|
|
1456 (defvar efs-ding-on-umask-failure t
|
|
|
1457 "*Ring the bell if the umask command fails on a unix host. Many servers don't
|
|
|
1458 support this command, so if you get a lot of annoying failures, set this
|
|
|
1459 to nil.")
|
|
|
1460
|
|
|
1461 (defvar efs-ding-on-chmod-failure t
|
|
|
1462 "*Ring the bell if the chmod command fails on a unix host. Some servers don't
|
|
|
1463 support this command, so if you get a lot of annoying failures, set this
|
|
|
1464 to nil.")
|
|
|
1465
|
|
|
1466 ;; Please let us know if you can contribute more entries to this guessing game.
|
|
|
1467 (defvar efs-nlist-cmd
|
|
|
1468 (cond
|
|
|
1469 ;; Covers Ultrix, SunOS, and NeXT.
|
|
|
1470 ((eq system-type 'berkeley-unix)
|
|
|
1471 "ls")
|
|
|
1472 ((memq system-type '(hpux aix-v3 silicon-graphics-unix))
|
|
|
1473 "nlist")
|
|
|
1474 ;; Blind guess
|
|
|
1475 ("ls"))
|
|
|
1476 "*FTP client command for getting a brief listing (NLST) from the FTP server.
|
|
|
1477 We try to guess this based on the local system-type, but obviously if you
|
|
|
1478 are using a gateway, you'll have to set it yourself.")
|
|
|
1479
|
|
|
1480 (defvar efs-compute-remote-buffer-file-truename nil
|
|
|
1481 "*If non-nil, `buffer-file-truename' will be computed for remote buffers.
|
|
|
1482 In emacs 19, each buffer has a local variable, `buffer-file-truename',
|
|
|
1483 which is used to ensure that symbolic links will not confuse emacs into
|
|
|
1484 visiting the same file with two buffers. This variable is computed by
|
|
|
1485 chasing all symbolic links in `buffer-file-name', both at the level of the
|
|
|
1486 file and at the level of all parent directories. Since this operation can be
|
|
|
1487 very time-consuming over FTP, this variable can be used to inhibit it.")
|
|
|
1488
|
|
|
1489 (defvar efs-buffer-name-case nil
|
|
|
1490 "*Selects the case used for buffer names of case-insensitive file names.
|
|
|
1491 Case-insensitive file names are files on hosts whose host type is in
|
|
|
1492 `efs-case-insensitive-host-types'.
|
|
|
1493
|
|
|
1494 If this is 'up upper case is used, if it is 'down lower case is used.
|
|
|
1495 If this has any other value, the case is inherited from the name used
|
|
|
1496 to access the file.")
|
|
|
1497
|
|
|
1498 (defvar efs-fancy-buffer-names "%s@%s"
|
|
|
1499 "Format used to compute names of buffers attached to remote files.
|
|
|
1500
|
|
|
1501 If this is nil, buffer names are computed in the usual way.
|
|
|
1502
|
|
|
1503 If it is a string, then the it is passed to format with second and third
|
|
|
1504 arguments the host name and file name.
|
|
|
1505
|
|
|
1506 Otherwise, it is assumed to be function taking three arguments, the host name,
|
|
|
1507 the user name, and the truncated file name. It should returns the name to
|
|
|
1508 be used for the buffer.")
|
|
|
1509
|
|
|
1510 (defvar efs-verify-anonymous-modtime nil
|
|
|
1511 "*Determines if efs checks modtimes for remote files on anonymous logins.
|
|
|
1512 If non-nil, efs runs `verify-visited-file-modtime' for remote files on
|
|
|
1513 anonymous ftp logins. Since verify-visited-file-modtime slows things down,
|
|
|
1514 and most people aren't editing files on anonymous ftp logins, this is nil
|
|
|
1515 by default.")
|
|
|
1516
|
|
|
1517 (defvar efs-verify-modtime-host-regexp ".*"
|
|
|
1518 "*Regexp to match host names for which efs checks file modtimes.
|
|
|
1519 If non-nil, efs will run `verify-visited-file-modtime' for remote
|
|
|
1520 files on hosts matching this regexp. If nil, verify-visited-file-modtime
|
|
|
1521 is supressed for all remote hosts. This is tested before
|
|
|
1522 `efs-verify-anonymous-modtime'.")
|
|
|
1523
|
|
|
1524 (defvar efs-maximize-idle nil
|
|
|
1525 "*If non-nil, efs will attempt to maximize the idle time out period.
|
|
|
1526 At some idle moment in the connection after login, efs will attempt to
|
|
|
1527 set the idle time out period to the maximum amount allowed by the server.
|
|
|
1528 It applies only to non-anonymous logins on unix hosts.")
|
|
|
1529
|
|
|
1530 (defvar efs-expire-ftp-buffers t
|
|
|
1531 "*If non-nil ftp buffers will be expired.
|
|
|
1532 The buffers will be killed either after `efs-ftp-buffer-expire-time' has
|
|
|
1533 elapsed with no activity, or the remote FTP server has timed out.")
|
|
|
1534
|
|
|
1535 (defvar efs-ftp-buffer-expire-time nil
|
|
|
1536 "*If non-nil, the time after which ftp buffers will be expired.
|
|
|
1537 If nil, ftp buffers will be expired only when the remote server has timed out.
|
|
|
1538 If an integer, ftp buffers will be expired either when the remote server
|
|
|
1539 has timed out, or when this many seconds on inactivity has elapsed.")
|
|
|
1540
|
|
|
1541 ;; If you need to increase this variable much, it is likely that
|
|
|
1542 ;; the true problem is timing errors between the efs process filter
|
|
|
1543 ;; and the FTP server. This could either be caused by the server
|
|
|
1544 ;; not following RFC959 response codes, or a bug in efs. In either
|
|
|
1545 ;; case please report the problem to us. If it's a bug, we'll fix it.
|
|
|
1546 ;; If the server is at fault we may try to do something. Our rule
|
|
|
1547 ;; of thumb is that we will support non-RFC959 behaviour, as long as
|
|
|
1548 ;; it doesn't risk breaking efs for servers which behave properly.
|
|
|
1549
|
|
|
1550 (defvar efs-retry-time 5
|
|
|
1551 "*Number of seconds to wait before retrying if data doesn't arrive.
|
|
|
1552 The FTP command isn't retried, rather efs just takes a second look
|
|
|
1553 for the data file. This might need to be increased for very slow FTP
|
|
|
1554 clients.")
|
|
|
1555
|
|
|
1556 (defvar efs-pty-check-threshold 1000
|
|
|
1557 "*How long efs waits before deciding that it doesn't have a pty.
|
|
|
1558 Specifically it is the number of iterations through `accept-process-output'
|
|
|
1559 that `efs-pty-p' waits before deciding that the pty is really a pipe.
|
|
|
1560 Set this to nil to inhibit checking for pty's. If efs seems to be
|
|
|
1561 mistaking some pty's for pipes, try increasing this number.")
|
|
|
1562
|
|
|
1563 (defvar efs-pty-check-retry-time 5
|
|
|
1564 "*Number of seconds that efs waits before retrying a pty check.
|
|
|
1565 This can be lengthened, if your FTP client is slow to start.")
|
|
|
1566
|
|
|
1567 (defvar efs-suppress-abort-recursive-edit-and-then nil
|
|
|
1568 "*If non-nil, `efs-abort-recursive-edit-and-then' will not run its function.
|
|
|
1569 This means that when a recursive edit is in progress, automatic popping of the
|
|
|
1570 FTP process buffer, and automatic popping of the bug report buffer will not
|
|
|
1571 work. `efs-abort-recursive-edit-and-then' works by forking a \"sleep 0\"
|
|
|
1572 process. On some unix implementations the forked process might be of the same
|
|
|
1573 size as the original GNU Emacs process. Forking such a large process just to
|
|
|
1574 do a \"sleep 0\" is probably not good.")
|
|
|
1575
|
|
|
1576 (defvar efs-ftp-buffer-format "*ftp %s@%s*"
|
|
|
1577 "Format to construct the name of FTP process buffers.
|
|
|
1578 This string is fed to `format' with second and third arguments the user
|
|
|
1579 name and host name.")
|
|
|
1580 ;; This does not affect the process name of the FTP client process.
|
|
|
1581 ;; That is always *ftp USER@HOST*
|
|
|
1582
|
|
|
1583 (defvar efs-debug-ftp-connection nil
|
|
|
1584 "*If non-nil, the user will be permitted to debug the FTP connection.
|
|
|
1585 This means that typing a C-g to the FTP process filter will give the user
|
|
|
1586 the option to type commands at the FTP connection. Normally, the connection
|
|
|
1587 is killed first. Note that doing this may result in the FTP process filter
|
|
|
1588 getting out of synch with the FTP client, so using this feature routinely
|
|
|
1589 isn't recommended.")
|
|
|
1590
|
|
|
1591 ;;; Hooks and crooks.
|
|
|
1592
|
|
|
1593 (defvar efs-ftp-startup-hook nil
|
|
|
1594 "Hook to run immediately after starting the FTP client.
|
|
|
1595 This hook is run before the FTP OPEN command is sent.")
|
|
|
1596
|
|
|
1597 (defvar efs-ftp-startup-function-alist nil
|
|
|
1598 "Association list of functions to running after FTP login.
|
|
|
1599 This should be an alist of the form '\(\(REGEXP . FUNCTION\) ...\), where
|
|
|
1600 REGEXP is a regular expression matched against the name of the remote host,
|
|
|
1601 and FUNCTION is a function of two arguments, HOST and USER. REGEXP is
|
|
|
1602 compared to the host name with `case-fold-search' bound to t. Only the first
|
|
|
1603 match in the alist is run.")
|
|
|
1604
|
|
|
1605 (defvar efs-load-hook nil
|
|
|
1606 "Hook to run immediately after loading efs.el.
|
|
|
1607 You can use it to alter definitions in efs.el, but why would you want
|
|
|
1608 to do such a thing?")
|
|
|
1609
|
|
|
1610 ;;;; -----------------------------------------------------------
|
|
|
1611 ;;;; Regexps for parsing FTP server responses.
|
|
|
1612 ;;;; -----------------------------------------------------------
|
|
|
1613 ;;;
|
|
|
1614 ;;; If you have to tune these variables, please let us know, so that
|
|
|
1615 ;;; we can get them right in the next release.
|
|
|
1616
|
|
|
1617 (defvar efs-multi-msgs
|
|
|
1618 ;; RFC959 compliant codes
|
|
|
1619 "^[1-5][0-5][0-7]-")
|
|
|
1620 ;; Regexp to match the start of an FTP server multiline reply.
|
|
|
1621
|
|
|
1622 (defvar efs-skip-msgs
|
|
|
1623 ;; RFC959 compliant codes
|
|
|
1624 (concat
|
|
|
1625 "^110 \\|" ; Restart marker reply.
|
|
|
1626 "^125 \\|" ; Data connection already open; transfer starting.
|
|
|
1627 "^150 ")) ; File status OK; about to open connection.
|
|
|
1628 ;; Regexp to match an FTP server response which we wish to ignore.
|
|
|
1629
|
|
|
1630 (defvar efs-cmd-ok-msgs
|
|
|
1631 ;; RFC959 compliant
|
|
|
1632 "^200 \\|^227 ")
|
|
|
1633 ;; Regexp to match the server command OK response.
|
|
|
1634 ;; Because PORT commands return this we usually ignore it. However, it is
|
|
|
1635 ;; a valid response for TYPE, SITE, and a few other commands (cf. RFC 959).
|
|
|
1636 ;; If we are explicitly sending a PORT, or one of these other commands,
|
|
|
1637 ;; then we don't want to ignore this response code. Also use this to match
|
|
|
1638 ;; the return code for PASV, as some clients burp these things out at odd
|
|
|
1639 ;; times.
|
|
|
1640
|
|
|
1641 (defvar efs-pending-msgs
|
|
|
1642 ;; RFC959 compliant
|
|
|
1643 "^350 ") ; Requested file action, pending further information.
|
|
|
1644 ;; Regexp to match the \"requested file action, pending further information\"
|
|
|
1645 ;; message. These are usually ignored, except if we are using RNFR to test for
|
|
|
1646 ;; file existence.
|
|
|
1647
|
|
|
1648 (defvar efs-cmd-ok-cmds
|
|
|
1649 (concat
|
|
|
1650 "^quote port \\|^type \\|^quote site \\|^chmod \\|^quote noop\\|"
|
|
|
1651 "^quote pasv"))
|
|
|
1652 ;; Regexp to match commands for which efs-cmd-ok-msgs is a valid server
|
|
|
1653 ;; response for success.
|
|
|
1654
|
|
|
1655 (defvar efs-passwd-cmds
|
|
|
1656 "^quote pass \\|^quote acct \\|^quote site gpass ")
|
|
|
1657 ;; Regexp to match commands for sending passwords.
|
|
|
1658 ;; All text following (match-end 0) will be replaced by "Turtle Power!"
|
|
|
1659
|
|
|
1660 (defvar efs-bytes-received-msgs
|
|
|
1661 ;; Strictly a client response
|
|
|
1662 "^[0-9]+ bytes ")
|
|
|
1663 ;; Regexp to match the reply from the FTP client that it has finished
|
|
|
1664 ;; receiving data.
|
|
|
1665
|
|
|
1666 (defvar efs-server-confused-msgs
|
|
|
1667 ;; ka9q uses this to indicate an incorrectly set transfer mode, and
|
|
|
1668 ;; then does send a second completion code for the command. This does
|
|
|
1669 ;; *not* conform to RFC959.
|
|
|
1670 "^100 Warning: type is ")
|
|
|
1671 ;; Regexp to match non-standard response from the FTP server. This can
|
|
|
1672 ;; sometimes be the result of an incorrectly set transfer mode. In this case
|
|
|
1673 ;; we do not rely on the server to tell us when the data transfer is complete,
|
|
|
1674 ;; but check with the client.
|
|
|
1675
|
|
|
1676 (defvar efs-good-msgs
|
|
|
1677 (concat
|
|
|
1678 ;; RFC959 compliant codes
|
|
|
1679 "^2[01345][0-7] \\|" ; 2yz = positive completion reply
|
|
|
1680 "^22[02-7] \\|" ; 221 = successful logout
|
|
|
1681 ; (Sometimes get this with a timeout,
|
|
|
1682 ; so treat as fatal.)
|
|
|
1683 "^3[0-5][0-7] \\|" ; 3yz = positive intermediate reply
|
|
|
1684 ;; client codes
|
|
|
1685 "^[Hh]ash mark "))
|
|
|
1686 ;; Response to indicate that the requested action was successfully completed.
|
|
|
1687
|
|
|
1688 (defvar efs-failed-msgs
|
|
|
1689 (concat
|
|
|
1690 ;; RFC959 compliant codes
|
|
|
1691 "^120 \\|" ; Service ready in nnn minutes.
|
|
|
1692 "^450 \\|" ; File action not taken; file is unavailable, or busy.
|
|
|
1693 "^452 \\|" ; Insufficient storage space on system.
|
|
|
1694 "^5[0-5][0-7] \\|" ; Permanent negative reply codes.
|
|
|
1695 ;; When clients tell us that a file doesn't exist, or can't access.
|
|
|
1696 "^\\(local: +\\)?/[^ ]* +"
|
|
|
1697 "\\([Nn]o such file or directory\\|[Nn]ot a plain file\\|"
|
|
|
1698 "The file access permissions do not allow \\|Is a directory\\b\\)"))
|
|
|
1699 ;; Regexp to match responses for failed commands. However, the ftp connection
|
|
|
1700 ;; is assumed to be good.
|
|
|
1701
|
|
|
1702 (defvar efs-fatal-msgs
|
|
|
1703 (concat
|
|
|
1704 ;; RFC959 codes
|
|
|
1705 "^221 \\|" ; Service closing control connection.
|
|
|
1706 "^421 \\|" ; Service not available.
|
|
|
1707 "^425 \\|" ; Can't open data connection.
|
|
|
1708 "^426 \\|" ; Connection closed, transfer aborted.
|
|
|
1709 "^451 \\|" ; Requested action aborted, local error in processing.
|
|
|
1710 ;; RFC959 non-compliant codes
|
|
|
1711 "^552 Maximum Idle Time Exceded\\.$\\|" ; Hellsoft server uses this to
|
|
|
1712 ; indicate a timeout. 552 is
|
|
|
1713 ; supposed to be used for exceeded
|
|
|
1714 ; storage allocation. Note that
|
|
|
1715 ; they also misspelled the error
|
|
|
1716 ; message.
|
|
|
1717 ;; client problems
|
|
|
1718 "^ftp: \\|^Not connected\\|^rcmd: \\|^No control connection\\|"
|
|
|
1719 "^unknown host\\|: unknown host$\\|^lost connection\\|"
|
|
|
1720 "^[Ss]egmentation fault\\|"
|
|
|
1721 ;; Make sure that the "local: " isn't just a message about a file.
|
|
|
1722 "^local: [^/]\\|"
|
|
|
1723 ;; Gateways
|
|
|
1724 "^iftp: cannot authenticate to server\\b"
|
|
|
1725 ))
|
|
|
1726 ;; Regexp to match responses that something has gone drastically wrong with
|
|
|
1727 ;; either the client, server, or connection. We kill the ftp process, and start
|
|
|
1728 ;; anew.
|
|
|
1729
|
|
|
1730 (defvar efs-unknown-response-msgs
|
|
|
1731 "^[0-9][0-9][0-9] ")
|
|
|
1732 ;; Regexp to match server response codes that we don't understand. This
|
|
|
1733 ;; is tested after all the other regexp, so it can match everything.
|
|
|
1734
|
|
|
1735 (defvar efs-pasv-msgs
|
|
|
1736 ;; According to RFC959.
|
|
|
1737 "^227 .*(\\([0-9]+,[0-9]+,[0-9]+,[0-9]+,[0-9]+,[0-9]+\\))$")
|
|
|
1738 ;; Matches the output of a PASV. (match-beginning 1) and (match-end 1)
|
|
|
1739 ;; must bracket the IP address and port.
|
|
|
1740
|
|
|
1741 (defvar efs-syst-msgs "^215 \\|^210 ")
|
|
|
1742 ;; 215 is RFC959. Plan 9 FTP server returns a 210. 210 is not assigned in
|
|
|
1743 ;; RFC 959.
|
|
|
1744 ;; The plan 9 people tell me that they fixed this. -- sr 18/4/94
|
|
|
1745 ;; Matches the output of a SYST.
|
|
|
1746
|
|
|
1747 (defvar efs-mdtm-msgs
|
|
|
1748 (concat
|
|
|
1749 "^213 [0-9][0-9][0-9][0-9][0-9][0-9][0-9]"
|
|
|
1750 "[0-9][0-9][0-9][0-9][0-9][0-9][0-9]$"))
|
|
|
1751 ;; Regexp to match the output of a quote mdtm command.
|
|
|
1752
|
|
|
1753 (defvar efs-idle-msgs
|
|
|
1754 "^200 [^0-9]+ \\([0-9]+\\)[^0-9]* max \\([0-9]+\\)")
|
|
|
1755 ;; Regexp to match the output of a SITE IDLE command.
|
|
|
1756 ;; Match 1 should refer to the current idle time, and match 2 the maximum
|
|
|
1757 ;; idle time.
|
|
|
1758
|
|
|
1759 (defvar efs-write-protect-msgs "^532 ") ; RFC959
|
|
|
1760 ;; Regexp to match a server ressponse to indicate that a STOR failed
|
|
|
1761 ;; because of insufficient write privileges.
|
|
|
1762
|
|
|
1763 (defvar efs-hash-mark-msgs
|
|
|
1764 "[hH]ash mark [^0-9]*\\([0-9]+\\)")
|
|
|
1765 ;; Regexp matching the FTP client's output upon doing a HASH command.
|
|
|
1766
|
|
|
1767 (defvar efs-xfer-size-msgs
|
|
|
1768 (concat
|
|
|
1769 ;; UN*X
|
|
|
1770 "^150 .* connection for .* (\\([0-9]+\\) bytes)\\|"
|
|
|
1771 ;; Wollongong VMS server.
|
|
|
1772 "^125 .* transfer started for .* (\\([0-9]+\\) bytes)\\|"
|
|
|
1773 ;; TOPS-20 server
|
|
|
1774 "^150 .* retrieve of .* ([0-9]+ pages?, \\([0-9]+\\) 7-bit bytes)"))
|
|
|
1775 ;; Regular expression used to determine the number of bytes
|
|
|
1776 ;; in a FTP transfer. The first (match-beginning #) which is non-nil is assumed
|
|
|
1777 ;; to give the size.
|
|
|
1778
|
|
|
1779 (defvar efs-expand-dir-msgs "^550 \\([^: ]+\\):")
|
|
|
1780 ;; Regexp to match the error response from a "get ~sandy".
|
|
|
1781 ;; By parsing the error, we can get a quick expansion of ~sandy
|
|
|
1782 ;; According to RFC 959, should be a 550.
|
|
|
1783
|
|
|
1784 (defvar efs-gateway-fatal-msgs
|
|
|
1785 "No route to host\\|Connection closed\\|No such host\\|Login incorrect")
|
|
|
1786 ;; Regular expression matching messages from the rlogin / telnet process that
|
|
|
1787 ;; indicates that logging in to the gateway machine has gone wrong.
|
|
|
1788
|
|
|
1789 (defvar efs-too-many-users-msgs
|
|
|
1790 ;; The test for "two many" is because some people can't spell.
|
|
|
1791 ;; I allow for up to two adjectives before "users".
|
|
|
1792 (concat
|
|
|
1793 "\\b[Tt][wo]o many\\( +[^ \n]+\\)?\\( +[^ \n]+\\)? +users\\b\\|"
|
|
|
1794 "\\btry back later\\b"))
|
|
|
1795 ;; Regular expresion to match what servers output when there are too many
|
|
|
1796 ;; anonymous logins. It is assumed that this is part of a 530 or 530- response
|
|
|
1797 ;; to USER or PASS.
|
|
|
1798
|
|
|
1799 ;;;; -------------------------------------------------------------
|
|
|
1800 ;;;; Buffer local FTP process variables
|
|
|
1801 ;;;; -------------------------------------------------------------
|
|
|
1802
|
|
|
1803 ;;; Variables buffer local to the process buffers are
|
|
|
1804 ;;; named with the prefix efs-process-
|
|
|
1805
|
|
|
1806 (defvar efs-process-q nil)
|
|
|
1807 ;; List of functions to be performed asynch.
|
|
|
1808 (make-variable-buffer-local 'efs-process-q)
|
|
|
1809
|
|
|
1810 (defvar efs-process-cmd-waiting nil)
|
|
|
1811 ;; Set to t if a process has a synchronous cmd waiting to execute.
|
|
|
1812 ;; In this case, it will allow the synch. cmd to run before returning to
|
|
|
1813 ;; the cmd queue.
|
|
|
1814 (make-variable-buffer-local 'efs-process-cmd-waiting)
|
|
|
1815
|
|
|
1816 (defvar efs-process-server-confused nil)
|
|
|
1817 (make-variable-buffer-local 'efs-process-server-confused)
|
|
|
1818
|
|
|
1819 (defvar efs-process-cmd nil)
|
|
|
1820 ;; The command currently being executed, as a string.
|
|
|
1821 (make-variable-buffer-local 'efs-process-cmd)
|
|
|
1822
|
|
|
1823 (defvar efs-process-xfer-size 0)
|
|
|
1824 (make-variable-buffer-local 'efs-process-xfer-size)
|
|
|
1825
|
|
|
1826 (defvar efs-process-umask nil)
|
|
|
1827 ;; nil if the umask hash not been set
|
|
|
1828 ;; an integer (the umask) if the umask has been set
|
|
|
1829 (make-variable-buffer-local 'efs-process-umask)
|
|
|
1830
|
|
|
1831 (defvar efs-process-idle-time nil)
|
|
|
1832 ;; If non-nil, the idle time of the server in seconds.
|
|
|
1833 (make-variable-buffer-local 'efs-process-idle-time)
|
|
|
1834
|
|
|
1835 (defvar efs-process-busy nil)
|
|
|
1836 (make-variable-buffer-local 'efs-process-busy)
|
|
|
1837
|
|
|
1838 (defvar efs-process-result-line "")
|
|
|
1839 (make-variable-buffer-local 'efs-process-result-line)
|
|
|
1840
|
|
|
1841 (defvar efs-process-result nil)
|
|
|
1842 (make-variable-buffer-local 'efs-process-result)
|
|
|
1843
|
|
|
1844 (defvar efs-process-result-cont-lines "")
|
|
|
1845 (make-variable-buffer-local 'efs-process-result-cont-lines)
|
|
|
1846
|
|
|
1847 (defvar efs-process-msg "")
|
|
|
1848 (make-variable-buffer-local 'efs-process-msg)
|
|
|
1849
|
|
|
1850 (defvar efs-process-nowait nil)
|
|
|
1851 (make-variable-buffer-local 'efs-process-nowait)
|
|
|
1852
|
|
|
1853 (defvar efs-process-string "")
|
|
|
1854 (make-variable-buffer-local 'efs-process-string)
|
|
|
1855
|
|
|
1856 (defvar efs-process-continue nil)
|
|
|
1857 (make-variable-buffer-local 'efs-process-continue)
|
|
|
1858
|
|
|
1859 (defvar efs-process-hash-mark-count 0)
|
|
|
1860 (make-variable-buffer-local 'efs-process-hash-mark-count)
|
|
|
1861
|
|
|
1862 (defvar efs-process-hash-mark-unit nil)
|
|
|
1863 (make-variable-buffer-local 'efs-process-hash-mark-unit)
|
|
|
1864
|
|
|
1865 (defvar efs-process-last-percent -1)
|
|
|
1866 (make-variable-buffer-local 'efs-process-last-percent)
|
|
|
1867
|
|
|
1868 (defvar efs-process-host nil)
|
|
|
1869 (make-variable-buffer-local 'efs-process-host)
|
|
|
1870
|
|
|
1871 (defvar efs-process-user nil)
|
|
|
1872 (make-variable-buffer-local 'efs-process-user)
|
|
|
1873
|
|
|
1874 (defvar efs-process-host-type nil)
|
|
|
1875 ;; Holds the host-type as a string, for showing it on the mode line.
|
|
|
1876 (make-variable-buffer-local 'efs-process-host-type)
|
|
|
1877
|
|
|
1878 (defvar efs-process-xfer-type nil)
|
|
|
1879 ;; Set to one of 'ascii, 'ebcdic, 'image, 'tenex, or nil to indicate
|
|
|
1880 ;; the current setting of the transfer type for the connection. nil means
|
|
|
1881 ;; that we don't know.
|
|
|
1882 (make-variable-buffer-local 'efs-process-xfer-type)
|
|
|
1883
|
|
|
1884 (defvar efs-process-client-altered-xfer-type nil)
|
|
|
1885 ;; Sometimes clients alter the xfer type, such as doing
|
|
|
1886 ;; an ls it is changed to ascii. If we are using quoted commands
|
|
|
1887 ;; to do xfers the client doesn't get a chance to set it back.
|
|
|
1888 (make-variable-buffer-local 'efs-process-client-altered-xfer-type)
|
|
|
1889
|
|
|
1890 (defvar efs-process-prompt-regexp nil)
|
|
|
1891 ;; local value of prompt of FTP client.
|
|
|
1892 (make-variable-buffer-local 'efs-process-prompt-regexp)
|
|
|
1893
|
|
|
1894 (defvar efs-process-cmd-counter 0)
|
|
|
1895 ;; Counts FTP commands, mod 16.
|
|
|
1896 (make-variable-buffer-local 'efs-process-cmd-counter)
|
|
|
1897
|
|
|
1898 ;;;; ------------------------------------------------------------
|
|
|
1899 ;;;; General Internal Variables.
|
|
|
1900 ;;;; ------------------------------------------------------------
|
|
|
1901
|
|
|
1902 ;;; For the byte compiler
|
|
|
1903 ;;
|
|
|
1904 ;; These variables are usually unbound. We are just notifying the
|
|
|
1905 ;; byte compiler that we know what we are doing.
|
|
|
1906
|
|
|
1907 (defvar bv-length) ; getting file versions.
|
|
|
1908 (defvar default-file-name-handler-alist) ; for file-name-handler-alist
|
|
|
1909 (defvar efs-completion-dir) ; for file name completion predicates
|
|
|
1910 (defvar dired-directory) ; for default actions in interactive specs
|
|
|
1911 (defvar dired-local-variables-file) ; for inhibiting child look ups
|
|
|
1912 (defvar dired-in-query) ; don't clobber dired queries with stat messages
|
|
|
1913 (defvar after-load-alist) ; in case we're in emacs 18.
|
|
|
1914 (defvar comint-last-input-start)
|
|
|
1915 (defvar comint-last-input-end)
|
|
|
1916 (defvar explicit-shell-file-name)
|
|
|
1917
|
|
|
1918 ;;; fluid vars
|
|
|
1919
|
|
|
1920 (defvar efs-allow-child-lookup t)
|
|
|
1921 ;; let-bind to nil, if want to inhibit child lookups.
|
|
|
1922
|
|
|
1923 (defvar efs-nested-cmd nil)
|
|
|
1924 ;; let-bound to t, when a cmd is executed by a cont or pre-cont.
|
|
|
1925 ;; Such cmds will never end by looking at the next item in the queue,
|
|
|
1926 ;; if they are run synchronously, but rely on their calling function
|
|
|
1927 ;; to do this.
|
|
|
1928
|
|
|
1929 ;;; polling ftp buffers
|
|
|
1930
|
|
|
1931 (defvar efs-ftp-buffer-poll-time 300
|
|
|
1932 "Period, in seconds, which efs will poll ftp buffers for activity.
|
|
|
1933 Used for expiring \(killing\) inactive ftp buffers.")
|
|
|
1934
|
|
|
1935 (defconst efs-ftp-buffer-alist nil)
|
|
|
1936 ;; alist of ftp buffers, and the total number of seconds that they
|
|
|
1937 ;; have been idle.
|
|
|
1938
|
|
|
1939 ;;; load extensions
|
|
|
1940
|
|
|
1941 (defvar efs-load-lisp-extensions '(".elc" ".el" "")
|
|
|
1942 "List of extensions to try when loading lisp files.")
|
|
|
1943
|
|
|
1944 ;;; mode-line
|
|
|
1945
|
|
|
1946 (defvar efs-mode-line-string "")
|
|
|
1947 ;; Stores the string that efs displays on the mode line.
|
|
|
1948
|
|
|
1949 ;;; data & temporary buffers
|
|
|
1950
|
|
|
1951 (defvar efs-data-buffer-name " *ftp data*")
|
|
|
1952 ;; Buffer name to hold directory listing data received from ftp process.
|
|
|
1953
|
|
|
1954 (defvar efs-data-buffer-name-2 " *ftp data-2*")
|
|
|
1955 ;; A second buffer name in which to hold directory listings.
|
|
|
1956 ;; Used for listings which are made during another directory listing.
|
|
|
1957
|
|
|
1958 ;;; process names
|
|
|
1959
|
|
|
1960 (defvar efs-ctime-process-name-format "*efs ctime %s*")
|
|
|
1961 ;; Passed to format with second arg the host name.
|
|
|
1962
|
|
|
1963 ;;; For temporary files.
|
|
|
1964
|
|
|
1965 ;; This is a list of symbols.
|
|
|
1966 (defconst efs-tmp-name-files ())
|
|
|
1967 ;; Here is where these symbols live:
|
|
|
1968 (defconst efs-tmp-name-obarray (make-vector 7 0))
|
|
|
1969 ;; We put our version of the emacs PID here:
|
|
|
1970 (defvar efs-pid nil)
|
|
|
1971
|
|
|
1972 ;;; For abort-recursive-edit
|
|
|
1973
|
|
|
1974 (defvar efs-abort-recursive-edit-data nil)
|
|
|
1975 (defvar efs-abort-recursive-edit-delay 5)
|
|
|
1976 ;; Number of seconds after which efs-abort-recursive-edit-and-then
|
|
|
1977 ;; will decide not to runs its sentinel. The assumption is that something
|
|
|
1978 ;; went wrong.
|
|
|
1979
|
|
|
1980 ;;; hashtables (Use defconst's to clobber any user silliness.)
|
|
|
1981
|
|
|
1982 (defconst efs-files-hashtable (efs-make-hashtable 97))
|
|
|
1983 ;; Hash table for storing directories and their respective files.
|
|
|
1984
|
|
|
1985 (defconst efs-expand-dir-hashtable (efs-make-hashtable))
|
|
|
1986 ;; Hash table of tilde expansions for remote directories.
|
|
|
1987
|
|
|
1988 (defconst efs-ls-converter-hashtable (efs-make-hashtable 37))
|
|
|
1989 ;; Hashtable for storing functions to convert listings from one
|
|
|
1990 ;; format to another. Keys are the required switches, and the values
|
|
|
1991 ;; are alist of the form ((SWITCHES . CONVERTER)...) where is SWITCHES
|
|
|
1992 ;; are the listing switches for the original listing, and CONVERTER is a
|
|
|
1993 ;; function of one-variable, the listing-type, to do the conversion
|
|
|
1994 ;; on data in the current buffer. SWITCHES is either a string, or nil.
|
|
|
1995 ;; nil means that the listing can be converted from cache in
|
|
|
1996 ;; efs-files-hashtable, a string from cache in efs-ls-cache. For the latter,
|
|
|
1997 ;; listings with no switches (dumb listings), represent SWITCHES as a string
|
|
|
1998 ;; consisting only of the ASCII null character.
|
|
|
1999
|
|
|
2000 ;;; cache variables (Use defconst's to clobber any user sillines.)
|
|
|
2001
|
|
|
2002 (defconst efs-ls-cache nil
|
|
|
2003 "List of results from efs-ls.
|
|
|
2004 Each entry is a list of four elements, the file listed, the switches used
|
|
|
2005 \(nil if none\), the listing string, and whether this string has already been
|
|
|
2006 parsed.")
|
|
|
2007
|
|
|
2008 (defvar efs-ls-uncache nil)
|
|
|
2009 ;; let-bind this to t, if you want to be sure that efs-ls will replace any
|
|
|
2010 ;; cache entries.
|
|
|
2011
|
|
|
2012 ;; This is a cache to see if the user has changed
|
|
|
2013 ;; completion-ignored-extensions.
|
|
|
2014 (defconst efs-completion-ignored-extensions completion-ignored-extensions
|
|
|
2015 "This variable is internal to efs. Do not set.
|
|
|
2016 See completion-ignored-extensions, instead.")
|
|
|
2017
|
|
|
2018 ;; We cache the regexp we use for completion-ignored-extensions. This
|
|
|
2019 ;; saves building a string every time we do completion. String construction
|
|
|
2020 ;; is costly in emacs.
|
|
|
2021 (defconst efs-completion-ignored-pattern
|
|
|
2022 (mapconcat (function
|
|
|
2023 (lambda (s) (if (stringp s)
|
|
|
2024 (concat (regexp-quote s) "$")
|
|
|
2025 "/"))) ; / never in filename
|
|
|
2026 efs-completion-ignored-extensions
|
|
|
2027 "\\|")
|
|
|
2028 "This variable is internal to efs. Do not set.
|
|
|
2029 See completion-ignored-extensions, instead.")
|
|
|
2030
|
|
|
2031 (defvar efs-system-fqdn nil
|
|
|
2032 "Cached value of the local systems' fully qualified domain name.")
|
|
|
2033
|
|
|
2034 ;;; The file-type-alist
|
|
|
2035
|
|
|
2036 ;; efs-file-type-alist is an alist indexed by host-type
|
|
|
2037 ;; which stores data on how files are structured on the given
|
|
|
2038 ;; host-type. Each entry is a list of three elements. The first is the
|
|
|
2039 ;; definition of a `byte', the second the native character representation,
|
|
|
2040 ;; and the third, the file structure.
|
|
|
2041 ;;
|
|
|
2042 ;; Meanings of the symbols:
|
|
|
2043 ;; ------------------------
|
|
|
2044 ;; The byte symbols:
|
|
|
2045 ;; 8-bit = bytes of 8-bits
|
|
|
2046 ;; 36-bit-wa = 36-bit word aligned. Precisely, the addressing unit is that
|
|
|
2047 ;; of a PDP-10 using the "<440700,,0> byte pointer".
|
|
|
2048 ;;
|
|
|
2049 ;; The native character set symbols:
|
|
|
2050 ;; 8-ascii = 8-bit NVT-ASCII
|
|
|
2051 ;; 7-ascii = 7-bit ascii as on a PDP-10
|
|
|
2052 ;; ebcdic = EBCDIC as on an IBM mainframe
|
|
|
2053 ;; lispm = the native character set on a lispm (Symbolics and LMI)
|
|
|
2054 ;; mts = native character representation in the Michigan Terminal System
|
|
|
2055 ;; (which runs on IBM and Amdal mainframes), similar to ebcdic
|
|
|
2056 ;;
|
|
|
2057 ;; The file structure symbols:
|
|
|
2058 ;;
|
|
|
2059 ;; file-nl = data is stored as a contiguous sequence of data bytes
|
|
|
2060 ;; with EOL denoted by <NL>.
|
|
|
2061 ;; file-crlf = data is stored as a contiguous sequence of data bytes
|
|
|
2062 ;; with EOL denoted by <CR-LF>
|
|
|
2063 ;; record = data is stored as a sequence of records
|
|
|
2064 ;; file-lispm = data as stored on a lispm. i.e. a sequence of bits
|
|
|
2065 ;; with EOL denoted by character code 138 (?)
|
|
|
2066 ;;
|
|
|
2067 ;; If we've messed anything up here, please let us know.
|
|
|
2068
|
|
|
2069 (defvar efs-file-type-alist
|
|
|
2070 '((unix . (8-bit 8-ascii file-nl))
|
|
|
2071 (sysV-unix . (8-bit 8-ascii file-nl))
|
|
|
2072 (bsd-unix . (8-bit 8-ascii file-nl))
|
|
|
2073 (apollo-unix . (8-bit 8-ascii file-nl))
|
|
|
2074 (dumb-apollo-unix . (8-bit 8-ascii file-nl))
|
|
|
2075 (dumb-unix . (8-bit 8-ascii file-nl))
|
|
|
2076 (super-dumb-unix . (8-bit 8-ascii file-nl))
|
|
|
2077 (guardian . (8-bit ascii file-nl))
|
|
|
2078 (plan9 . (8-bit 8-ascii file-nl))
|
|
|
2079 (dos . (8-bit 8-ascii file-crlf))
|
|
|
2080 (ms-unix . (8-bit 8-ascii file-crlf))
|
|
|
2081 (netware . (8-bit 8-ascii file-crlf))
|
|
|
2082 (os2 . (8-bit 8-ascii file-crlf))
|
|
|
2083 (tops-20 . (36-bit-wa 7-ascii file-crlf))
|
|
|
2084 (mpe . (8-bit 8-ascii record))
|
|
|
2085 (mvs . (8-bit ebcdic record))
|
|
|
2086 (cms . (8-bit ebcdic record))
|
|
|
2087 (cms-knet . (8-bit ebcdic record))
|
|
|
2088 (mts . (8-bit mts record)) ; mts seems to have its own char rep.
|
|
|
2089 ; Seems to be close to ebcdic, but not the same.
|
|
|
2090 (dos-distinct . (8-bit 8-ascii file-crlf))
|
|
|
2091 (ka9q . (8-bit 8-ascii file-crlf))
|
|
|
2092 (vms . (8-bit 8-ascii record)) ; The mysteries of VMS's RMS.
|
|
|
2093 (hell . (8-bit 8-ascii file-crlf))
|
|
|
2094 (vos . (8-bit 8-ascii record))
|
|
|
2095 (ti-explorer . (8-bit lispm file-lispm)) ; lispms use a file structure, but
|
|
|
2096 ; use an out of range char to
|
|
|
2097 ; indicate EOL.
|
|
|
2098 (ti-twenex . (8-bit lispm file-lispm))
|
|
|
2099 (nos-ve . (8-bit 8-ascii record))
|
|
|
2100 (coke . (8-bit 8-ascii file-nl)) ; only support 8-bit beverages
|
|
|
2101 (nil . (8-bit 8-ascii file-nl)))) ; the local host
|
|
|
2102
|
|
|
2103 ;;; Status messages
|
|
|
2104
|
|
|
2105 (defvar efs-last-message-time -86400) ; yesterday
|
|
|
2106 ;; The time of the last efs status message. c.f. efs-message-interval
|
|
|
2107
|
|
|
2108 ;;; For handling dir listings
|
|
|
2109
|
|
|
2110 ;; This MUST match all the way to to the start of the filename.
|
|
|
2111 ;; This version corresponds to what dired now uses (sandy, 14.1.93)
|
|
|
2112 (defvar efs-month-and-time-regexp
|
|
|
2113 (concat
|
|
|
2114 " \\([0-9]+\\) +" ; file size
|
|
|
2115 "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|June?\\|July?\\|Aug\\|Sep\\|Oct"
|
|
|
2116 ; June and July are for HP-UX 9.0
|
|
|
2117 "\\|Nov\\|Dec\\) \\([ 0-3][0-9]\\)\\("
|
|
|
2118 " [012][0-9]:[0-6][0-9] \\|" ; time
|
|
|
2119 " [12][90][0-9][0-9] \\|" ; year on IRIX, NeXT, SunOS, ULTRIX, Apollo
|
|
|
2120 ; HP-UX, A/UX
|
|
|
2121 " [12][90][0-9][0-9] \\)" ; year on AIX
|
|
|
2122 ))
|
|
|
2123
|
|
|
2124 (defvar efs-month-alist
|
|
|
2125 '(("Jan" . 1) ("Feb". 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6)
|
|
|
2126 ("June" . 6) ("Jul" . 7) ("July" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10)
|
|
|
2127 ("Nov" . 11) ("Dec" . 12)))
|
|
|
2128
|
|
|
2129 ;; Matches the file modes, link number, and owner string.
|
|
|
2130 ;; The +/- is for extended file access permissions.
|
|
|
2131 (defvar efs-modes-links-owner-regexp
|
|
|
2132 (concat
|
|
|
2133 "\\([^ ][-r][-w][^ ][-r][-w][^ ][-r][-w][^ ]\\)[-+]? *\\([0-9]+\\)"
|
|
|
2134 " +\\([^ ]+\\) "))
|
|
|
2135
|
|
|
2136 ;;;; ---------------------------------------------------------------
|
|
|
2137 ;;;; efs-dired variables
|
|
|
2138 ;;;; ---------------------------------------------------------------
|
|
|
2139
|
|
|
2140 ;; These variables must be here, instead of in efs-dired.el, because
|
|
|
2141 ;; the efs-HOST-TYPE.el files need to add to it.
|
|
|
2142 (defvar efs-dired-re-exe-alist nil
|
|
|
2143 "Association list of regexps which match file lines of executable files.")
|
|
|
2144
|
|
|
2145 (defvar efs-dired-re-dir-alist nil
|
|
|
2146 "Association list of regexps which match file lines of subdirectories.")
|
|
|
2147
|
|
|
2148 (defvar efs-dired-host-type nil
|
|
|
2149 "Host type of a dired buffer. \(buffer local\)")
|
|
|
2150 (make-variable-buffer-local 'efs-dired-host-type)
|
|
|
2151
|
|
|
2152 (defvar efs-dired-listing-type nil
|
|
|
2153 "Listing type of a dired buffer. \(buffer local\)")
|
|
|
2154 (make-variable-buffer-local 'efs-dired-listing-type)
|
|
|
2155
|
|
|
2156 (defvar efs-dired-listing-type-string nil)
|
|
|
2157 (make-variable-buffer-local 'efs-dired-listing-type-string)
|
|
|
2158
|
|
|
2159 ;;;; -------------------------------------------------------------
|
|
|
2160 ;;;; New error symbols.
|
|
|
2161 ;;;; -------------------------------------------------------------
|
|
|
2162
|
|
|
2163 (put 'ftp-error 'error-conditions '(ftp-error file-error error))
|
|
|
2164 ;; (put 'ftp-error 'error-message "FTP error")
|
|
|
2165
|
|
|
2166
|
|
|
2167 ;;;; =============================================================
|
|
|
2168 ;;;; >3
|
|
|
2169 ;;;; Utilities
|
|
|
2170 ;;;; =============================================================
|
|
|
2171
|
|
|
2172 ;;; -------------------------------------------------------------------
|
|
|
2173 ;;; General Macros (Make sure that macros are defined before they're
|
|
|
2174 ;;; used, for the byte compiler.
|
|
|
2175 ;;; -------------------------------------------------------------------
|
|
|
2176
|
|
|
2177 (defmacro efs-kbd-quit-protect (proc &rest body)
|
|
|
2178 ;; When an efs function controlling an FTP connection gets a kbd-quit
|
|
|
2179 ;; this tries to make sure that everything unwinds consistently.
|
|
|
2180 (let ((temp (make-symbol "continue")))
|
|
|
2181 (list 'let
|
|
|
2182 (list '(quit-flag nil)
|
|
|
2183 '(inhibit-quit nil)
|
|
|
2184 (list temp t))
|
|
|
2185 (list
|
|
|
2186 'while temp
|
|
|
2187 (list 'setq temp nil)
|
|
|
2188 (list
|
|
|
2189 'condition-case nil
|
|
|
2190 (cons 'progn
|
|
|
2191 body)
|
|
|
2192 (list 'quit
|
|
|
2193 (list 'setq temp
|
|
|
2194 (list 'efs-kbd-quit-protect-cover-quit proc))))))))
|
|
|
2195
|
|
|
2196 (defun efs-kbd-quit-protect-cover-quit (proc)
|
|
|
2197 ;; This function exists to keep the macro expansion of the
|
|
|
2198 ;; efs-kbd-quit-protect down to a reasonable size.
|
|
|
2199 (let ((pop-up-windows t)
|
|
|
2200 (buff (get-buffer (process-buffer proc)))
|
|
|
2201 res)
|
|
|
2202 (if (save-window-excursion
|
|
|
2203 (if buff
|
|
|
2204 (progn
|
|
|
2205 (pop-to-buffer buff)
|
|
|
2206 (goto-char (point-max))
|
|
|
2207 (recenter (- (window-height)
|
|
|
2208 2))))
|
|
|
2209 (setq res (efs-kill-ftp-buffer-with-prompt proc buff)))
|
|
|
2210 (progn
|
|
|
2211 (if (eq res 0)
|
|
|
2212 (if (eq (selected-window)
|
|
|
2213 (minibuffer-window))
|
|
|
2214 (efs-abort-recursive-edit-and-then
|
|
|
2215 (function
|
|
|
2216 (lambda (buff)
|
|
|
2217 (if (get-buffer buff)
|
|
|
2218 (display-buffer buff))))
|
|
|
2219 buff)
|
|
|
2220 (if (get-buffer buff)
|
|
|
2221 (display-buffer buff))
|
|
|
2222 (signal 'quit nil))
|
|
|
2223 (if (eq (selected-window) (minibuffer-window))
|
|
|
2224 (abort-recursive-edit)
|
|
|
2225 (signal (quote quit) nil)))
|
|
|
2226 nil)
|
|
|
2227 (sit-for 0)
|
|
|
2228 (message "Waiting on %s..." (or (car (efs-parse-proc-name proc))
|
|
|
2229 "a whim"))
|
|
|
2230 t)))
|
|
|
2231
|
|
|
2232 (put 'efs-kbd-quit-protect 'lisp-indent-hook 1)
|
|
|
2233
|
|
|
2234 (defmacro efs-save-buffer-excursion (&rest forms)
|
|
|
2235 "Execute FORMS, restoring the current buffer afterwards.
|
|
|
2236 Unlike, save-excursion, this does not restore the point."
|
|
|
2237 (let ((temp (make-symbol "saved-buff")))
|
|
|
2238 (list 'let
|
|
|
2239 (list (list temp '(current-buffer)))
|
|
|
2240 (list 'unwind-protect
|
|
|
2241 (cons 'progn forms)
|
|
|
2242 (list 'condition-case nil
|
|
|
2243 (list 'set-buffer temp)
|
|
|
2244 '(error nil))))))
|
|
|
2245
|
|
|
2246 (put 'efs-save-buffer-excursion 'lisp-indent-hook 0)
|
|
|
2247
|
|
|
2248 (defmacro efs-unquote-dollars (string)
|
|
|
2249 ;; Unquote $$'s to $'s in STRING.
|
|
|
2250 (` (let ((string (, string))
|
|
|
2251 (start 0)
|
|
|
2252 new)
|
|
|
2253 (while (string-match "\\$\\$" string start)
|
|
|
2254 (setq new (concat new (substring
|
|
|
2255 string start (1+ (match-beginning 0))))
|
|
|
2256 start (match-end 0)))
|
|
|
2257 (if new
|
|
|
2258 (concat new (substring string start))
|
|
|
2259 string))))
|
|
|
2260
|
|
|
2261 (defmacro efs-get-file-part (path)
|
|
|
2262 ;; Given PATH, return the file part used for looking up the file's entry
|
|
|
2263 ;; in a hashtable.
|
|
|
2264 ;; This need not be the same thing as file-name-nondirectory.
|
|
|
2265 (` (let ((file (file-name-nondirectory (, path))))
|
|
|
2266 (if (string-equal file "")
|
|
|
2267 "."
|
|
|
2268 file))))
|
|
|
2269
|
|
|
2270 (defmacro efs-ftp-path-macro (path)
|
|
|
2271 ;; Just a macro version of efs-ftp-path, for speed critical
|
|
|
2272 ;; situations. Could use (inline ...) instead, but not everybody
|
|
|
2273 ;; uses the V19 byte-compiler. Also, doesn't call efs-save-match-data,
|
|
|
2274 ;; but assumes that the calling function does it.
|
|
|
2275 (`
|
|
|
2276 (let ((path (, path)))
|
|
|
2277 (or (string-equal path efs-ftp-path-arg)
|
|
|
2278 (setq efs-ftp-path-res
|
|
|
2279 (and (string-match efs-path-regexp path)
|
|
|
2280 (let ((host (substring path (match-beginning 2)
|
|
|
2281 (match-end 2)))
|
|
|
2282 (user (and (match-beginning 1)
|
|
|
2283 (substring path (match-beginning 1)
|
|
|
2284 (1- (match-end 1)))))
|
|
|
2285 (rpath (substring path (1+ (match-end 2)))))
|
|
|
2286 (list (if (string-equal host "")
|
|
|
2287 (setq host (system-name))
|
|
|
2288 host)
|
|
|
2289 (or user (efs-get-user host))
|
|
|
2290 rpath)))
|
|
|
2291 ;; Set this last, in case efs-get-user calls this function,
|
|
|
2292 ;; which would modify an earlier setting.
|
|
|
2293 efs-ftp-path-arg path))
|
|
|
2294 efs-ftp-path-res)))
|
|
|
2295
|
|
|
2296 (defmacro efs-canonize-switches (switches)
|
|
|
2297 ;; Converts a switches string, into a lexographically ordered string,
|
|
|
2298 ;; omitting - and spaces. Should we remove duplicate characters too?
|
|
|
2299 (` (if (, switches)
|
|
|
2300 (mapconcat
|
|
|
2301 'char-to-string
|
|
|
2302 (sort (delq ?- (delq ?\ (mapcar 'identity (, switches)))) '<) "")
|
|
|
2303 ;; For the purpose of interning in a hashtable, represent the nil
|
|
|
2304 ;; switches, as a string consisting of the ascii null character.
|
|
|
2305 (char-to-string 0))))
|
|
|
2306
|
|
|
2307 (defmacro efs-canonize-file-name (fn)
|
|
|
2308 ;; Canonizes the case of file names.
|
|
|
2309 (` (let ((parsed (efs-ftp-path (, fn))))
|
|
|
2310 (if parsed
|
|
|
2311 (let ((host (car parsed)))
|
|
|
2312 (if (memq (efs-host-type host) efs-case-insensitive-host-types)
|
|
|
2313 (downcase (, fn))
|
|
|
2314 (format efs-path-format-string (nth 1 parsed) (downcase host)
|
|
|
2315 (nth 2 parsed))))
|
|
|
2316 (, fn)))))
|
|
|
2317
|
|
|
2318 (defmacro efs-get-files-hashtable-entry (fn)
|
|
|
2319 (` (efs-get-hash-entry (efs-canonize-file-name (, fn)) efs-files-hashtable)))
|
|
|
2320
|
|
|
2321 ;;;; ------------------------------------------------------------
|
|
|
2322 ;;;; Utility Functions
|
|
|
2323 ;;;; ------------------------------------------------------------
|
|
|
2324
|
|
|
2325 (defun efs-kill-ftp-buffer-with-prompt (proc buffer)
|
|
|
2326 ;; Does a 3-way prompt to kill a ftp PROC and BUFFER.
|
|
|
2327 ;; Returns t if buffer was killed, 0 if only process, nil otherwise.
|
|
|
2328 (let ((inhibit-quit t)
|
|
|
2329 (cursor-in-echo-area t)
|
|
|
2330 char)
|
|
|
2331 (message
|
|
|
2332 (if efs-debug-ftp-connection
|
|
|
2333 "Kill ftp process and buffer (y[es], n[o], c[lose], d[ebug] ) "
|
|
|
2334 "Kill ftp process and buffer? (y or n, c to only close process) "))
|
|
|
2335 (setq char (read-char))
|
|
|
2336 (prog1
|
|
|
2337 (cond
|
|
|
2338 ((memq char '(?y ?Y ?\ ))
|
|
|
2339 (set-process-sentinel proc nil)
|
|
|
2340 (condition-case nil
|
|
|
2341 (kill-buffer buffer)
|
|
|
2342 (error nil))
|
|
|
2343 t)
|
|
|
2344 ((memq char '(?c ?C))
|
|
|
2345 (set-process-sentinel proc nil)
|
|
|
2346 (condition-case nil
|
|
|
2347 (save-excursion
|
|
|
2348 (set-buffer buffer)
|
|
|
2349 (setq efs-process-busy nil
|
|
|
2350 efs-process-q nil)
|
|
|
2351 (delete-process proc))
|
|
|
2352 (error nil))
|
|
|
2353 0)
|
|
|
2354 ((memq char '(?n ?N))
|
|
|
2355 (message "")
|
|
|
2356 nil)
|
|
|
2357 ((and efs-debug-ftp-connection
|
|
|
2358 (memq char '(?d ?D)))
|
|
|
2359 (condition-case nil
|
|
|
2360 (save-excursion
|
|
|
2361 (set-buffer buffer)
|
|
|
2362 (setq efs-process-busy nil
|
|
|
2363 efs-process-q nil))
|
|
|
2364 (error nil))
|
|
|
2365 0)
|
|
|
2366 (t
|
|
|
2367 (message
|
|
|
2368 (if efs-debug-ftp-connection
|
|
|
2369 "Type one of y, n, c or d."
|
|
|
2370 "Type one of y, n or c."))
|
|
|
2371 (ding)
|
|
|
2372 (sit-for 1)
|
|
|
2373 (setq quit-flag nil)
|
|
|
2374 (efs-kill-ftp-buffer-with-prompt proc buffer))))))
|
|
|
2375
|
|
|
2376 (defun efs-barf-if-not-directory (directory)
|
|
|
2377 ;; Signal an error if DIRECTORY is not one.
|
|
|
2378 (or (file-directory-p directory)
|
|
|
2379 (signal 'file-error
|
|
|
2380 (list "Opening directory"
|
|
|
2381 (if (file-exists-p directory)
|
|
|
2382 "not a directory"
|
|
|
2383 "no such file or directory")
|
|
|
2384 directory))))
|
|
|
2385
|
|
|
2386 (defun efs-call-cont (cont &rest args)
|
|
|
2387 "Call the function specified by CONT.
|
|
|
2388 CONT can be either a function or a list of a function and some args.
|
|
|
2389 The first parameters passed to the function will be ARGS. The remaining
|
|
|
2390 args will be taken from CONT if a list was passed."
|
|
|
2391 (if cont
|
|
|
2392 (let ((efs-nested-cmd t)) ; let-bound so that conts don't pop any queues
|
|
|
2393 (efs-save-buffer-excursion
|
|
|
2394 (if (and (listp cont)
|
|
|
2395 (not (eq (car cont) 'lambda)))
|
|
|
2396 (apply (car cont) (append args (cdr cont)))
|
|
|
2397 (apply cont args))))))
|
|
|
2398
|
|
|
2399 (defun efs-replace-path-component (fullpath path)
|
|
|
2400 "For FULLPATH matching efs-path-regexp replace the path component with PATH."
|
|
|
2401 (efs-save-match-data
|
|
|
2402 (if (string-match efs-path-root-regexp fullpath)
|
|
|
2403 (concat (substring fullpath 0 (match-end 0)) path)
|
|
|
2404 path)))
|
|
|
2405
|
|
|
2406 (defun efs-abort-recursive-edit-and-then (fun &rest args)
|
|
|
2407 ;; Does an abort-recursive-edit, and runs fun _after_ emacs returns to
|
|
|
2408 ;; top level.
|
|
|
2409 (if (get-process "efs-abort-recursive-edit")
|
|
|
2410 ;; Don't queue these things. Clean them out.
|
|
|
2411 (delete-process "efs-abort-recursive-edit"))
|
|
|
2412 (or efs-suppress-abort-recursive-edit-and-then
|
|
|
2413 (progn
|
|
|
2414 (setq efs-abort-recursive-edit-data (cons (nth 1 (current-time))
|
|
|
2415 (cons fun args)))
|
|
|
2416 (condition-case nil
|
|
|
2417 (set-process-sentinel
|
|
|
2418 (let ((default-directory exec-directory)
|
|
|
2419 (process-connection-type nil))
|
|
|
2420 (start-process "efs-abort-recursive-edit" nil "sleep" "0"))
|
|
|
2421 (function
|
|
|
2422 (lambda (proc string)
|
|
|
2423 (let ((data efs-abort-recursive-edit-data))
|
|
|
2424 (setq efs-abort-recursive-edit-data)
|
|
|
2425 (if (and data
|
|
|
2426 (integerp (car data))
|
|
|
2427 (<= (- (nth 1 (current-time)) (car data))
|
|
|
2428 efs-abort-recursive-edit-delay))
|
|
|
2429 (apply (nth 1 data) (nthcdr 2 data)))))))
|
|
|
2430 (error nil))))
|
|
|
2431 (abort-recursive-edit))
|
|
|
2432
|
|
|
2433 (defun efs-occur-in-string (char string)
|
|
|
2434 ;; Return the number of occurrences of CHAR in STRING.
|
|
|
2435 (efs-save-match-data
|
|
|
2436 (let ((regexp (regexp-quote (char-to-string char)))
|
|
|
2437 (count 0)
|
|
|
2438 (start 0))
|
|
|
2439 (while (string-match regexp string start)
|
|
|
2440 (setq start (match-end 0)
|
|
|
2441 count (1+ count)))
|
|
|
2442 count)))
|
|
|
2443
|
|
|
2444 (defun efs-parse-proc-name (proc)
|
|
|
2445 ;; Parses the name of process to return a list \(host user\).
|
|
|
2446 (efs-save-match-data
|
|
|
2447 (let ((name (process-name proc)))
|
|
|
2448 (and name
|
|
|
2449 (string-match "^\\*ftp \\([^@]*\\)@\\([^*]+\\)\\*$" name)
|
|
|
2450 (list (substring name (match-beginning 2) (match-end 2))
|
|
|
2451 (substring name (match-beginning 1) (match-end 1)))))))
|
|
|
2452
|
|
|
2453 ;;;; ------------------------------------------------------------
|
|
|
2454 ;;;; Of Geography, connectivity, and the internet... Gateways.
|
|
|
2455 ;;;; ------------------------------------------------------------
|
|
|
2456
|
|
|
2457 (defun efs-use-gateway-p (host &optional opaque-p)
|
|
|
2458 ;; Returns whether to access this host via a gateway.
|
|
|
2459 ;; Returns the gateway type as a symbol. See efs-gateway-type <V>.
|
|
|
2460 ;; If optional OPAQUE-P is non-nil, only returns non-nil if the gateway
|
|
|
2461 ;; type is in the list efs-opaque-gateways <V>.
|
|
|
2462 (and efs-gateway-type
|
|
|
2463 host ;local host is nil
|
|
|
2464 (efs-save-match-data
|
|
|
2465 (and (not (string-match efs-ftp-local-host-regexp host))
|
|
|
2466 (let ((type (car efs-gateway-type)))
|
|
|
2467 (if opaque-p
|
|
|
2468 (and (memq type efs-opaque-gateways) type)
|
|
|
2469 type))))))
|
|
|
2470
|
|
|
2471 (defun efs-local-to-gateway-filename (filename &optional reverse)
|
|
|
2472 ;; Converts a FILENAME on the local host to its name on the gateway,
|
|
|
2473 ;; using efs-gateway-mounted-dirs-alist. If REVERSE is non-nil, does just
|
|
|
2474 ;; that. If the there is no corresponding name because non of its parent
|
|
|
2475 ;; directories are mounted, returns nil.
|
|
|
2476 (if efs-gateway-mounted-dirs-alist
|
|
|
2477 (let ((len (length filename))
|
|
|
2478 (alist efs-gateway-mounted-dirs-alist)
|
|
|
2479 result elt elt-len)
|
|
|
2480 (if reverse
|
|
|
2481 (while (setq elt (car alist))
|
|
|
2482 (if (and (>= len (setq elt-len (length (cdr elt))))
|
|
|
2483 (string-equal (cdr elt) (substring filename 0 elt-len)))
|
|
|
2484 (setq result (concat (car elt)
|
|
|
2485 (substring filename elt-len))
|
|
|
2486 alist nil)
|
|
|
2487 (setq alist (cdr alist))))
|
|
|
2488 (while (setq elt (car alist))
|
|
|
2489 (if (and (>= len (setq elt-len (length (car elt))))
|
|
|
2490 (string-equal (car elt) (substring filename 0 elt-len)))
|
|
|
2491 (setq result (concat (cdr elt)
|
|
|
2492 (substring filename elt-len))
|
|
|
2493 alist nil)
|
|
|
2494 (setq alist (cdr alist)))))
|
|
|
2495 result)))
|
|
|
2496
|
|
|
2497 ;;; ------------------------------------------------------------
|
|
|
2498 ;;; Enhanced message support.
|
|
|
2499 ;;; ------------------------------------------------------------
|
|
|
2500
|
|
|
2501 (defun efs-message (fmt &rest args)
|
|
|
2502 "Output the given message, truncating to the size of the minibuffer window."
|
|
|
2503 (let ((msg (apply (function format) fmt args))
|
|
|
2504 (max (window-width (minibuffer-window))))
|
|
|
2505 (if (>= (length msg) max)
|
|
|
2506 (setq msg (concat "> " (substring msg (- 3 max)))))
|
|
|
2507 (message "%s" msg)))
|
|
|
2508
|
|
|
2509 (defun efs-message-p ()
|
|
|
2510 ;; Returns t, if efs is allowed to display a status message.
|
|
|
2511 (not
|
|
|
2512 (or (and (boundp 'dired-in-query) dired-in-query)
|
|
|
2513 (boundp 'search-message)
|
|
|
2514 cursor-in-echo-area
|
|
|
2515 (and (/= efs-message-interval 0)
|
|
|
2516 (let ((diff (- efs-last-message-time
|
|
|
2517 (setq efs-last-message-time
|
|
|
2518 (nth 1 (current-time))))))
|
|
|
2519 (and
|
|
|
2520 (> diff (- efs-message-interval))
|
|
|
2521 (< diff 0))))))) ; in case the clock wraps.
|
|
|
2522
|
|
|
2523 (efs-define-fun efs-relativize-filename (file &optional dir new)
|
|
|
2524 "Abbreviate the given filename relative to DIR .
|
|
|
2525 If DIR is nil, use the value of `default-directory' for the currently selected
|
|
|
2526 window. If the optional parameter NEW is given and the
|
|
|
2527 non-directory parts match, only return the directory part of the file."
|
|
|
2528 (let* ((dir (or dir (save-excursion
|
|
|
2529 (set-buffer (window-buffer (selected-window)))
|
|
|
2530 default-directory)))
|
|
|
2531 (dlen (length dir))
|
|
|
2532 (result file))
|
|
|
2533 (and (> (length file) dlen)
|
|
|
2534 (string-equal (substring file 0 dlen) dir)
|
|
|
2535 (setq result (substring file dlen)))
|
|
|
2536 (and new
|
|
|
2537 (string-equal (file-name-nondirectory result)
|
|
|
2538 (file-name-nondirectory new))
|
|
|
2539 (or (setq result (file-name-directory result))
|
|
|
2540 (setq result "./")))
|
|
|
2541 (abbreviate-file-name result)))
|
|
|
2542
|
|
|
2543 ;;; ------------------------------------------------------------
|
|
|
2544 ;;; Temporary file location and deletion...
|
|
|
2545 ;;; ------------------------------------------------------------
|
|
|
2546
|
|
|
2547 (defun efs-get-pid ()
|
|
|
2548 ;; Half-hearted attempt to get the current process's id.
|
|
|
2549 (setq efs-pid (substring (make-temp-name "") 1)))
|
|
|
2550
|
|
|
2551 (defun efs-make-tmp-name (host1 host2)
|
|
|
2552 ;; Returns the name of a new temp file, for moving data between HOST1
|
|
|
2553 ;; and HOST2. This temp file must be directly accessible to the
|
|
|
2554 ;; FTP client connected to HOST1. Using nil for either HOST1 or
|
|
|
2555 ;; HOST2 means the local host. The return value is actually a list
|
|
|
2556 ;; whose car is the name of the temp file wrto to the local host
|
|
|
2557 ;; and whose cdr is the name of the temp file wrto to the host
|
|
|
2558 ;; on which the client connected to HOST1 is running. If the gateway
|
|
|
2559 ;; is only accessible by FTP, then the car of this may be in efs extended
|
|
|
2560 ;; file name syntax.
|
|
|
2561 (let ((pid (or efs-pid (efs-get-pid)))
|
|
|
2562 (start ?a)
|
|
|
2563 file entry template rem-template template-len)
|
|
|
2564 ;; Compute the templates.
|
|
|
2565 (if (null (and host1 (efs-use-gateway-p host1 t)))
|
|
|
2566 ;; file must be local
|
|
|
2567 (if (null (and host2 (efs-use-gateway-p host2 t)))
|
|
|
2568 (setq template efs-tmp-name-template)
|
|
|
2569 (setq template (or (efs-local-to-gateway-filename
|
|
|
2570 efs-gateway-tmp-name-template t)
|
|
|
2571 efs-tmp-name-template)))
|
|
|
2572 ;; file must be on the gateway -- make sure that the gateway
|
|
|
2573 ;; configuration is sensible.
|
|
|
2574 (efs-save-match-data
|
|
|
2575 (or (string-match efs-ftp-local-host-regexp efs-gateway-host)
|
|
|
2576 (error "Gateway %s must be directly ftp accessible."
|
|
|
2577 efs-gateway-host)))
|
|
|
2578 (setq rem-template efs-gateway-tmp-name-template
|
|
|
2579 template (or (efs-local-to-gateway-filename
|
|
|
2580 efs-gateway-tmp-name-template t)
|
|
|
2581 (format efs-path-format-string
|
|
|
2582 (efs-get-user efs-gateway-host)
|
|
|
2583 efs-gateway-host
|
|
|
2584 efs-gateway-tmp-name-template))
|
|
|
2585 template-len (length template)))
|
|
|
2586 ;; Compute a new file name.
|
|
|
2587 (while (let (efs-verbose)
|
|
|
2588 (setq file (format "%s%c%s" template start pid)
|
|
|
2589 entry (intern file efs-tmp-name-obarray))
|
|
|
2590 (or (memq entry efs-tmp-name-files)
|
|
|
2591 (file-exists-p file)))
|
|
|
2592 (if (> (setq start (1+ start)) ?z)
|
|
|
2593 (progn
|
|
|
2594 (setq template (concat template "X"))
|
|
|
2595 (setq start ?a))))
|
|
|
2596 (setq efs-tmp-name-files
|
|
|
2597 (cons entry efs-tmp-name-files))
|
|
|
2598 (if rem-template
|
|
|
2599 (cons file (concat rem-template (substring file template-len)))
|
|
|
2600 (cons file file))))
|
|
|
2601
|
|
|
2602 (defun efs-del-tmp-name (temp)
|
|
|
2603 ;; Deletes file TEMP, a string.
|
|
|
2604 (setq efs-tmp-name-files
|
|
|
2605 (delq (intern temp efs-tmp-name-obarray)
|
|
|
2606 efs-tmp-name-files))
|
|
|
2607 (condition-case ()
|
|
|
2608 (let (efs-verbose)
|
|
|
2609 (delete-file temp))
|
|
|
2610 (error nil)))
|
|
|
2611
|
|
|
2612
|
|
|
2613 ;;;; ==============================================================
|
|
|
2614 ;;;; >4
|
|
|
2615 ;;;; Hosts, Users, Accounts, and Passwords
|
|
|
2616 ;;;; ==============================================================
|
|
|
2617 ;;;
|
|
|
2618 ;;; A lot of the support for this type of thing is in efs-netrc.el.
|
|
|
2619
|
|
|
2620 ;;;; ------------------------------------------------------------
|
|
|
2621 ;;;; Password support.
|
|
|
2622 ;;;; ------------------------------------------------------------
|
|
|
2623
|
|
|
2624 (defun efs-lookup-passwd (host user)
|
|
|
2625 ;; Look up the password for HOST and USER.
|
|
|
2626 (let ((ent (efs-get-host-user-property host user 'passwd)))
|
|
|
2627 (and ent (efs-code-string ent))))
|
|
|
2628
|
|
|
2629 (defun efs-system-fqdn ()
|
|
|
2630 "Returns a fully qualified domain name for the current host, if possible."
|
|
|
2631 (or efs-system-fqdn
|
|
|
2632 (setq efs-system-fqdn
|
|
|
2633 (let ((sys (system-name)))
|
|
|
2634 (if (string-match "\\." sys)
|
|
|
2635 sys
|
|
|
2636 (if efs-nslookup-program
|
|
|
2637 (let ((proc (let ((default-directory exec-directory)
|
|
|
2638 (process-connection-type nil))
|
|
|
2639 (start-process " *nslookup*" " *nslookup*"
|
|
|
2640 efs-nslookup-program sys)))
|
|
|
2641 (res sys)
|
|
|
2642 (n 0))
|
|
|
2643 (process-kill-without-query proc)
|
|
|
2644 (save-excursion
|
|
|
2645 (set-buffer (process-buffer proc))
|
|
|
2646 (let ((quit-flag nil)
|
|
|
2647 (inhibit-quit nil))
|
|
|
2648 (if efs-nslookup-threshold
|
|
|
2649 (progn
|
|
|
2650 (while (and (memq (process-status proc)
|
|
|
2651 '(run open))
|
|
|
2652 (< n efs-nslookup-threshold))
|
|
|
2653 (accept-process-output)
|
|
|
2654 (setq n (1+ n)))
|
|
|
2655 (if (>= n efs-nslookup-threshold)
|
|
|
2656 (progn
|
|
|
2657 (with-output-to-temp-buffer "*Help*"
|
|
|
2658 (princ (format "\
|
|
|
2659 efs is unable to determine a fully qualified domain name
|
|
|
2660 for the local host to send as an anonymous ftp password.
|
|
|
2661
|
|
|
2662 The function `system-name' is not returning a fully qualified
|
|
|
2663 domain name. An attempt to obtain a fully qualified domain name
|
|
|
2664 with `efs-nslookup-program' (currently set to \"%s\") has
|
|
|
2665 elicited no response from that program. Consider setting
|
|
|
2666 `efs-generate-anonymous-password' to an email address for anonymous
|
|
|
2667 ftp passwords.
|
|
|
2668
|
|
|
2669 For more information see the documentation (use C-h v) for the
|
|
|
2670 variables `efs-nslookup-program' and `efs-nslookup-threshold'."
|
|
|
2671 efs-nslookup-program)))
|
|
|
2672 (error "No response from %s"
|
|
|
2673 efs-nslookup-program))))
|
|
|
2674 (while (memq (process-status proc) '(run open))
|
|
|
2675 (accept-process-output proc)))
|
|
|
2676 (goto-char (point-min))
|
|
|
2677 (if (re-search-forward
|
|
|
2678 (format "^Name: *\\(%s\\.[^ \n\t]+\\)"
|
|
|
2679 sys) nil t)
|
|
|
2680 (setq res (buffer-substring
|
|
|
2681 (match-beginning 1)
|
|
|
2682 (match-end 1)))
|
|
|
2683 (kill-buffer (current-buffer)))))
|
|
|
2684 res)
|
|
|
2685 sys))))))
|
|
|
2686
|
|
|
2687 (defun efs-passwd-unique-list (alist)
|
|
|
2688 ;; Preserving the relative order of ALIST, remove all entries with duplicate
|
|
|
2689 ;; cars.
|
|
|
2690 (let (result)
|
|
|
2691 (while alist
|
|
|
2692 (or (assoc (car alist) result)
|
|
|
2693 (setq result (cons (car alist) result)))
|
|
|
2694 (setq alist (cdr alist)))
|
|
|
2695 (nreverse result)))
|
|
|
2696
|
|
|
2697 (defun efs-get-passwd-list (user host)
|
|
|
2698 ;; Returns an alist of the form '((pass host user) ...).
|
|
|
2699 ;; The order is essentially arbitrary, except that entries with user
|
|
|
2700 ;; equal to USER will appear first. Followed by entries with host equal to
|
|
|
2701 ;; HOST. Also, there will be no entries with duplicate values of pass.
|
|
|
2702 (efs-parse-netrc)
|
|
|
2703 (let* ((user-template (concat "/" user))
|
|
|
2704 (ulen (length user-template))
|
|
|
2705 (hlen (length host))
|
|
|
2706 primaries secondaries tertiaries)
|
|
|
2707 (efs-save-match-data
|
|
|
2708 (efs-map-hashtable
|
|
|
2709 (function
|
|
|
2710 (lambda (key passwd)
|
|
|
2711 (cond ((null passwd) nil)
|
|
|
2712 ((and (> (length key) ulen)
|
|
|
2713 (string-equal user-template
|
|
|
2714 (substring key (- ulen))))
|
|
|
2715 (setq primaries (cons (list (efs-code-string passwd)
|
|
|
2716 (substring key 0 (- ulen))
|
|
|
2717 (substring user-template 1))
|
|
|
2718 primaries)))
|
|
|
2719 ((and (> (length key) hlen)
|
|
|
2720 (string-equal host (substring key 0 hlen))
|
|
|
2721 (memq (aref key hlen) '(?/ ?.)))
|
|
|
2722 (if (string-match "/" key hlen)
|
|
|
2723 (setq secondaries
|
|
|
2724 (cons (list (efs-code-string passwd)
|
|
|
2725 (substring key 0 (match-beginning 0))
|
|
|
2726 (substring key (match-end 0)))
|
|
|
2727 secondaries))))
|
|
|
2728 ((string-match "/" key)
|
|
|
2729 (setq tertiaries
|
|
|
2730 (cons (list (efs-code-string passwd)
|
|
|
2731 (substring key 0 (match-beginning 0))
|
|
|
2732 (substring key (match-end 0)))
|
|
|
2733 tertiaries))))))
|
|
|
2734 efs-host-user-hashtable 'passwd))
|
|
|
2735 (efs-passwd-unique-list (nconc primaries secondaries tertiaries))))
|
|
|
2736
|
|
|
2737 (defun efs-get-passwd (host user)
|
|
|
2738 "Given a HOST and USER, return the FTP password, prompting if it was not
|
|
|
2739 previously set."
|
|
|
2740 (efs-parse-netrc)
|
|
|
2741
|
|
|
2742 ;; look up password in the hash table first; user might have overriden the
|
|
|
2743 ;; defaults.
|
|
|
2744 (cond ((efs-lookup-passwd host user))
|
|
|
2745
|
|
|
2746 ;; see if default user and password set from the .netrc file.
|
|
|
2747 ((and (stringp efs-default-user)
|
|
|
2748 efs-default-password
|
|
|
2749 (string-equal user efs-default-user))
|
|
|
2750 (copy-sequence efs-default-password))
|
|
|
2751
|
|
|
2752 ;; anonymous ftp password is handled specially since there is an
|
|
|
2753 ;; unwritten rule about how that is used on the Internet.
|
|
|
2754 ((and (efs-anonymous-p user)
|
|
|
2755 efs-generate-anonymous-password)
|
|
|
2756 (if (stringp efs-generate-anonymous-password)
|
|
|
2757 (copy-sequence efs-generate-anonymous-password)
|
|
|
2758 (concat (user-login-name) "@" (efs-system-fqdn))))
|
|
|
2759
|
|
|
2760 ;; see if same user has logged in to other hosts; if so then prompt
|
|
|
2761 ;; with the password that was used there.
|
|
|
2762 (t
|
|
|
2763 (let (others defaults passwd)
|
|
|
2764 (unwind-protect
|
|
|
2765 (progn
|
|
|
2766 (setq others (efs-get-passwd-list user host)
|
|
|
2767 defaults (mapcar
|
|
|
2768 (function
|
|
|
2769 (lambda (x)
|
|
|
2770 (cons
|
|
|
2771 (format
|
|
|
2772 "Passwd for %s@%s (same as %s@%s): "
|
|
|
2773 user host (nth 2 x) (nth 1 x))
|
|
|
2774 (car x))))
|
|
|
2775 others))
|
|
|
2776 (setq passwd
|
|
|
2777 (read-passwd
|
|
|
2778 (or defaults
|
|
|
2779 (format "Password for %s@%s: " user host)))))
|
|
|
2780 (while others
|
|
|
2781 (fillarray (car (car others)) 0)
|
|
|
2782 (setq others (cdr others))))
|
|
|
2783 (or (null passwd)
|
|
|
2784 (and efs-high-security-hosts
|
|
|
2785 (efs-save-match-data
|
|
|
2786 (string-match efs-high-security-hosts
|
|
|
2787 (format "%s@%s" user host))))
|
|
|
2788 (efs-set-passwd host user passwd))
|
|
|
2789 passwd))))
|
|
|
2790
|
|
|
2791 ;;;; ------------------------------------------------------------
|
|
|
2792 ;;;; Account support
|
|
|
2793 ;;;; ------------------------------------------------------------
|
|
|
2794
|
|
|
2795 (defun efs-get-account (host user &optional minidisk really)
|
|
|
2796 "Given a HOST, USER, and optional MINIDISK return the FTP account password.
|
|
|
2797 If the optional REALLY argument is given, prompts the user if it can't find
|
|
|
2798 one."
|
|
|
2799 (efs-parse-netrc)
|
|
|
2800 (let ((account (if minidisk
|
|
|
2801 (efs-get-hash-entry
|
|
|
2802 (concat (downcase host) "/" user "/" minidisk)
|
|
|
2803 efs-minidisk-hashtable
|
|
|
2804 (memq (efs-host-type host)
|
|
|
2805 efs-case-insensitive-host-types))
|
|
|
2806 (efs-get-host-user-property host user 'account))))
|
|
|
2807 (if account
|
|
|
2808 (efs-code-string account)
|
|
|
2809 ;; Do we really want to send the default-account passwd for all
|
|
|
2810 ;; minidisks?
|
|
|
2811 (if (and (stringp efs-default-user)
|
|
|
2812 (string-equal user efs-default-user)
|
|
|
2813 efs-default-account)
|
|
|
2814 efs-default-account
|
|
|
2815 (and really
|
|
|
2816 (let ((acct
|
|
|
2817 (read-passwd
|
|
|
2818 (if minidisk
|
|
|
2819 (format
|
|
|
2820 "Write access password for minidisk %s on %s@%s: "
|
|
|
2821 minidisk user host)
|
|
|
2822 (format
|
|
|
2823 "Account password for %s@%s: " user host)))))
|
|
|
2824 (or (and efs-high-security-hosts
|
|
|
2825 (efs-save-match-data
|
|
|
2826 efs-high-security-hosts
|
|
|
2827 (format "%s@%s" user host)))
|
|
|
2828 (efs-set-account host user minidisk acct))
|
|
|
2829 acct))))))
|
|
|
2830
|
|
|
2831 ;;;; -------------------------------------------------------------
|
|
|
2832 ;;;; Special classes of users.
|
|
|
2833 ;;;; -------------------------------------------------------------
|
|
|
2834
|
|
|
2835 (defun efs-anonymous-p (user)
|
|
|
2836 ;; Returns t if USER should be treated as an anonymous FTP login.
|
|
|
2837 (let ((user (downcase user)))
|
|
|
2838 (or (string-equal user "anonymous") (string-equal user "ftp"))))
|
|
|
2839
|
|
|
2840
|
|
|
2841 ;;;; =============================================================
|
|
|
2842 ;;;; >5
|
|
|
2843 ;;;; FTP client process, and server responses
|
|
|
2844 ;;;; =============================================================
|
|
|
2845
|
|
|
2846 ;;;; ---------------------------------------------------------
|
|
|
2847 ;;;; Support for asynch process queues.
|
|
|
2848 ;;;; ---------------------------------------------------------
|
|
|
2849
|
|
|
2850 (defun efs-add-to-queue (host user item)
|
|
|
2851 "To the end of the command queue for HOST and USER, adds ITEM.
|
|
|
2852 Does nothing if there is no process buffer for HOST and USER."
|
|
|
2853 (let ((buff (efs-ftp-process-buffer host user)))
|
|
|
2854 (if (get-buffer buff)
|
|
|
2855 (save-excursion
|
|
|
2856 (set-buffer buff)
|
|
|
2857 (setq efs-process-q
|
|
|
2858 (nconc efs-process-q (list item)))))))
|
|
|
2859
|
|
|
2860 ;;;; -------------------------------------------------------
|
|
|
2861 ;;;; Error recovery for the process filter.
|
|
|
2862 ;;;; -------------------------------------------------------
|
|
|
2863
|
|
|
2864 ;;; Could make this better, but it's such an unlikely error to hit.
|
|
|
2865 (defun efs-process-scream-and-yell (line)
|
|
|
2866 (let* ((buff (buffer-name (current-buffer)))
|
|
|
2867 (host (and (string-match "@\\(.*\\)\\*$" buff)
|
|
|
2868 (substring buff (match-beginning 1) (match-end 1)))))
|
|
|
2869 (with-output-to-temp-buffer "*Help*"
|
|
|
2870 (princ
|
|
|
2871 (concat
|
|
|
2872 "efs is unable to identify the following reply code
|
|
|
2873 from the ftp server " host ":\n\n" line "
|
|
|
2874
|
|
|
2875 Please send a bug report to ange@hplb.hpl.hp.com.
|
|
|
2876 In your report include a transcript of your\n"
|
|
|
2877 buff " buffer."))))
|
|
|
2878 (error "Unable to identify server code."))
|
|
|
2879
|
|
|
2880 (defun efs-error (host user msg)
|
|
|
2881 "Signal \'ftp-error for the FTP connection for HOST and USER.
|
|
|
2882 The error gives the string MSG as text. The process buffer for the FTP
|
|
|
2883 is popped up in another window."
|
|
|
2884 (let ((cur (selected-window))
|
|
|
2885 (pop-up-windows t)
|
|
|
2886 (buff (get-buffer (efs-ftp-process-buffer host user))))
|
|
|
2887 (if buff
|
|
|
2888 (progn
|
|
|
2889 (pop-to-buffer buff)
|
|
|
2890 (goto-char (point-max))
|
|
|
2891 (select-window cur))))
|
|
|
2892 (signal 'ftp-error (list (format "FTP Error: %s" msg))))
|
|
|
2893
|
|
|
2894 ;;;; --------------------------------------------------------------------
|
|
|
2895 ;;;; Process filter and supporting functions for handling FTP codes.
|
|
|
2896 ;;;; --------------------------------------------------------------------
|
|
|
2897
|
|
|
2898 (defun efs-process-handle-line (line proc)
|
|
|
2899 ;; Look at the given LINE from the ftp process PROC and try to catagorize it.
|
|
|
2900 (cond ((string-match efs-xfer-size-msgs line)
|
|
|
2901 (let ((n 1))
|
|
|
2902 ;; this loop will bomb with an args out of range error at 10
|
|
|
2903 (while (not (match-beginning n))
|
|
|
2904 (setq n (1+ n)))
|
|
|
2905 (setq efs-process-xfer-size
|
|
|
2906 (ash (string-to-int (substring line
|
|
|
2907 (match-beginning n)
|
|
|
2908 (match-end n)))
|
|
|
2909 -10))))
|
|
|
2910
|
|
|
2911 ((string-match efs-multi-msgs line)
|
|
|
2912 (setq efs-process-result-cont-lines
|
|
|
2913 (concat efs-process-result-cont-lines line "\n")))
|
|
|
2914
|
|
|
2915 ((string-match efs-skip-msgs line))
|
|
|
2916
|
|
|
2917 ((string-match efs-cmd-ok-msgs line)
|
|
|
2918 (if (string-match efs-cmd-ok-cmds efs-process-cmd)
|
|
|
2919 (setq efs-process-busy nil
|
|
|
2920 efs-process-result nil
|
|
|
2921 efs-process-result-line line)))
|
|
|
2922
|
|
|
2923 ((string-match efs-pending-msgs line)
|
|
|
2924 (if (string-match "^quote rnfr " efs-process-cmd)
|
|
|
2925 (setq efs-process-busy nil
|
|
|
2926 efs-process-result nil
|
|
|
2927 efs-process-result-line line)))
|
|
|
2928
|
|
|
2929 ((string-match efs-bytes-received-msgs line)
|
|
|
2930 (if efs-process-server-confused
|
|
|
2931 (setq efs-process-busy nil
|
|
|
2932 efs-process-result nil
|
|
|
2933 efs-process-result-line line)))
|
|
|
2934
|
|
|
2935 ((string-match efs-server-confused-msgs line)
|
|
|
2936 (setq efs-process-server-confused t))
|
|
|
2937
|
|
|
2938 ((string-match efs-good-msgs line)
|
|
|
2939 (setq efs-process-busy nil
|
|
|
2940 efs-process-result nil
|
|
|
2941 efs-process-result-line line))
|
|
|
2942
|
|
|
2943 ((string-match efs-fatal-msgs line)
|
|
|
2944 (set-process-sentinel proc nil)
|
|
|
2945 (delete-process proc)
|
|
|
2946 (setq efs-process-busy nil
|
|
|
2947 efs-process-result 'fatal
|
|
|
2948 efs-process-result-line line))
|
|
|
2949
|
|
|
2950 ((string-match efs-failed-msgs line)
|
|
|
2951 (setq efs-process-busy nil
|
|
|
2952 efs-process-result 'failed
|
|
|
2953 efs-process-result-line line))
|
|
|
2954
|
|
|
2955 ((string-match efs-unknown-response-msgs line)
|
|
|
2956 (setq efs-process-busy nil
|
|
|
2957 efs-process-result 'weird
|
|
|
2958 efs-process-result-line line)
|
|
|
2959 (efs-process-scream-and-yell line))))
|
|
|
2960
|
|
|
2961 (efs-define-fun efs-process-log-string (proc str)
|
|
|
2962 ;; For a given PROCESS, log the given STRING at the end of its
|
|
|
2963 ;; associated buffer.
|
|
|
2964 (let ((buff (get-buffer (process-buffer proc))))
|
|
|
2965 (if buff
|
|
|
2966 (efs-save-buffer-excursion
|
|
|
2967 (set-buffer buff)
|
|
|
2968 (comint-output-filter proc str)))))
|
|
|
2969
|
|
|
2970 (defun efs-process-filter (proc str)
|
|
|
2971 ;; Build up a complete line of output from the ftp PROCESS and pass it
|
|
|
2972 ;; on to efs-process-handle-line to deal with.
|
|
|
2973 (let ((inhibit-quit t)
|
|
|
2974 (buffer (get-buffer (process-buffer proc)))
|
|
|
2975 (efs-default-directory default-directory))
|
|
|
2976
|
|
|
2977 ;; see if the buffer is still around... it could have been deleted.
|
|
|
2978 (if buffer
|
|
|
2979 (efs-save-buffer-excursion
|
|
|
2980 (set-buffer (process-buffer proc))
|
|
|
2981 (efs-save-match-data
|
|
|
2982
|
|
|
2983 ;; handle hash mark printing
|
|
|
2984 (if efs-process-busy
|
|
|
2985 (setq str (efs-process-handle-hash str)
|
|
|
2986 efs-process-string (concat efs-process-string str)))
|
|
|
2987 (efs-process-log-string proc str)
|
|
|
2988 (while (and efs-process-busy
|
|
|
2989 (string-match "\n" efs-process-string))
|
|
|
2990 (let ((line (substring efs-process-string
|
|
|
2991 0
|
|
|
2992 (match-beginning 0))))
|
|
|
2993 (setq efs-process-string (substring
|
|
|
2994 efs-process-string
|
|
|
2995 (match-end 0)))
|
|
|
2996 ;; If we are in synch with the client, we should
|
|
|
2997 ;; never get prompts in the wrong place. Just to be safe,
|
|
|
2998 ;; chew them off.
|
|
|
2999 (while (string-match efs-process-prompt-regexp line)
|
|
|
3000 (setq line (substring line (match-end 0))))
|
|
|
3001 (efs-process-handle-line line proc)))
|
|
|
3002
|
|
|
3003 ;; has the ftp client finished? if so then do some clean-up
|
|
|
3004 ;; actions.
|
|
|
3005 (if (not efs-process-busy)
|
|
|
3006 (progn
|
|
|
3007 (efs-correct-hash-mark-size)
|
|
|
3008 ;; reset process-kill-without-query
|
|
|
3009 (process-kill-without-query proc)
|
|
|
3010 ;; issue the "done" message since we've finished.
|
|
|
3011 (if (and efs-process-msg
|
|
|
3012 (efs-message-p)
|
|
|
3013 (null efs-process-result))
|
|
|
3014 (progn
|
|
|
3015
|
|
|
3016 (efs-message "%s...done" efs-process-msg)
|
|
|
3017 (setq efs-process-msg nil)))
|
|
|
3018
|
|
|
3019 (if (and efs-process-nowait
|
|
|
3020 (null efs-process-cmd-waiting))
|
|
|
3021
|
|
|
3022 (progn
|
|
|
3023 ;; Is there a continuation we should be calling?
|
|
|
3024 ;; If so, we'd better call it, making sure we
|
|
|
3025 ;; only call it once.
|
|
|
3026 (if efs-process-continue
|
|
|
3027 (let ((cont efs-process-continue))
|
|
|
3028 (setq efs-process-continue nil)
|
|
|
3029 (efs-call-cont
|
|
|
3030 cont
|
|
|
3031 efs-process-result
|
|
|
3032 efs-process-result-line
|
|
|
3033 efs-process-result-cont-lines)))
|
|
|
3034 ;; If the cmd was run asynch, run the next
|
|
|
3035 ;; cmd from the queue. For synch cmds, this
|
|
|
3036 ;; is done by efs-send-cmd. For asynch
|
|
|
3037 ;; cmds we don't care about
|
|
|
3038 ;; efs-nested-cmd, since nothing is
|
|
|
3039 ;; waiting for the cmd to complete. If
|
|
|
3040 ;; efs-process-cmd-waiting is t, exit
|
|
|
3041 ;; to let this command run.
|
|
|
3042 (if (and efs-process-q
|
|
|
3043 ;; Be careful to check efs-process-busy
|
|
|
3044 ;; again, because the cont may have started
|
|
|
3045 ;; some new ftp action.
|
|
|
3046 ;; wheels within wheels...
|
|
|
3047 (null efs-process-busy))
|
|
|
3048 (let ((next (car efs-process-q)))
|
|
|
3049 (setq efs-process-q
|
|
|
3050 (cdr efs-process-q))
|
|
|
3051 (apply 'efs-send-cmd
|
|
|
3052 efs-process-host
|
|
|
3053 efs-process-user
|
|
|
3054 next))))
|
|
|
3055
|
|
|
3056 (if efs-process-continue
|
|
|
3057 (let ((cont efs-process-continue))
|
|
|
3058 (setq efs-process-continue nil)
|
|
|
3059 (efs-call-cont
|
|
|
3060 cont
|
|
|
3061 efs-process-result
|
|
|
3062 efs-process-result-line
|
|
|
3063 efs-process-result-cont-lines))))
|
|
|
3064
|
|
|
3065 ;; Update the mode line
|
|
|
3066 ;; We can't test nowait to see if we changed the
|
|
|
3067 ;; modeline in the first place, because conts
|
|
|
3068 ;; may be running now, which will confuse the issue.
|
|
|
3069 ;; The logic is simpler if we update the modeline
|
|
|
3070 ;; before the cont, but then the user sees the
|
|
|
3071 ;; modeline track the cont execution. It's dizzying.
|
|
|
3072 (if (and (or efs-mode-line-format
|
|
|
3073 efs-ftp-activity-function)
|
|
|
3074 (null efs-process-busy))
|
|
|
3075 (efs-update-mode-line)))))
|
|
|
3076
|
|
|
3077 ;; Trim buffer, if required.
|
|
|
3078 (and efs-max-ftp-buffer-size
|
|
|
3079 (zerop efs-process-cmd-counter)
|
|
|
3080 (> (point-max) efs-max-ftp-buffer-size)
|
|
|
3081 (= (point-min) 1) ; who knows, the user may have narrowed.
|
|
|
3082 (null (get-buffer-window (current-buffer)))
|
|
|
3083 (save-excursion
|
|
|
3084 (goto-char (/ efs-max-ftp-buffer-size 2))
|
|
|
3085 (forward-line 1)
|
|
|
3086 (delete-region (point-min) (point))))))))
|
|
|
3087
|
|
|
3088 ;;;; ------------------------------------------------------------------
|
|
|
3089 ;;;; Functions for counting hashes and reporting on bytes transferred.
|
|
|
3090 ;;;; ------------------------------------------------------------------
|
|
|
3091
|
|
|
3092 (defun efs-set-xfer-size (host user bytes)
|
|
|
3093 ;; Set the size of the next FTP transfer in bytes.
|
|
|
3094 (let ((proc (efs-get-process host user)))
|
|
|
3095 (if proc
|
|
|
3096 (let ((buf (process-buffer proc)))
|
|
|
3097 (if buf
|
|
|
3098 (save-excursion
|
|
|
3099 (set-buffer buf)
|
|
|
3100 (setq efs-process-xfer-size (ash bytes -10))))))))
|
|
|
3101
|
|
|
3102 (defun efs-guess-incoming-bin-hm-size ()
|
|
|
3103 ;; Guess at the hash mark size for incoming binary transfers by taking
|
|
|
3104 ;; the average value for such transfers to other hosts.
|
|
|
3105 (let ((total 0)
|
|
|
3106 (n 0))
|
|
|
3107 (efs-map-hashtable
|
|
|
3108 (function
|
|
|
3109 (lambda (host hm-size)
|
|
|
3110 (if hm-size (setq total (+ total hm-size)
|
|
|
3111 n (1+ n)))))
|
|
|
3112 efs-host-hashtable
|
|
|
3113 'incoming-bin-hm-size)
|
|
|
3114 (and (> n 0) (/ total n))))
|
|
|
3115
|
|
|
3116 (defun efs-set-hash-mark-unit (host user &optional incoming)
|
|
|
3117 ;; Sets the value of efs-process-hash-mark-unit according to the xfer-type.
|
|
|
3118 ;; efs-hash-mark-unit is the number of bytes represented by a hash mark,
|
|
|
3119 ;; in units of 16. If INCOMING is non-nil, the xfer will be a GET.
|
|
|
3120 (if efs-send-hash
|
|
|
3121 (let ((buff (efs-ftp-process-buffer host user))
|
|
|
3122 (gate-p (efs-use-gateway-p host t)))
|
|
|
3123 (if buff
|
|
|
3124 (save-excursion
|
|
|
3125 (set-buffer buff)
|
|
|
3126 (setq efs-process-hash-mark-unit
|
|
|
3127 (ash (or
|
|
|
3128 (and incoming (eq efs-process-xfer-type 'image)
|
|
|
3129 (or (efs-get-host-property
|
|
|
3130 host 'incoming-bin-hm-size)
|
|
|
3131 (if gate-p
|
|
|
3132 efs-gateway-incoming-binary-hm-size
|
|
|
3133 efs-incoming-binary-hm-size)
|
|
|
3134 (let ((guess
|
|
|
3135 (efs-guess-incoming-bin-hm-size)))
|
|
|
3136 (and guess
|
|
|
3137 (efs-set-host-property
|
|
|
3138 host 'incoming-bin-hm-size
|
|
|
3139 guess)))))
|
|
|
3140 (if gate-p
|
|
|
3141 efs-gateway-hash-mark-size
|
|
|
3142 efs-hash-mark-size)
|
|
|
3143 1024) ; make sure that we have some integer
|
|
|
3144 -4)))))))
|
|
|
3145
|
|
|
3146 (defun efs-correct-hash-mark-size ()
|
|
|
3147 ;; Corrects the value of efs-{ascii,binary}-hash-mark-size.
|
|
|
3148 ;; Must be run in the process buffer.
|
|
|
3149 (and efs-send-hash
|
|
|
3150 efs-process-hash-mark-unit
|
|
|
3151 (> efs-process-xfer-size 0)
|
|
|
3152 (< efs-process-xfer-size 524288) ; 2^19, prevent overflows
|
|
|
3153 (> efs-process-hash-mark-count 0)
|
|
|
3154 (or (> efs-process-last-percent 100)
|
|
|
3155 (< (ash (* efs-process-hash-mark-unit
|
|
|
3156 (1+ efs-process-hash-mark-count )) -6)
|
|
|
3157 efs-process-xfer-size))
|
|
|
3158 (let ((val (ash (/ (ash efs-process-xfer-size 6)
|
|
|
3159 efs-process-hash-mark-count) 4)))
|
|
|
3160 (if (and (eq efs-process-xfer-type 'image)
|
|
|
3161 (>= (length efs-process-cmd) 4)
|
|
|
3162 (string-equal (downcase (substring efs-process-cmd 0 4))
|
|
|
3163 "get "))
|
|
|
3164 (efs-set-host-property efs-process-host 'incoming-bin-hm-size val)
|
|
|
3165 (set (if (efs-use-gateway-p efs-process-host t)
|
|
|
3166 'efs-gateway-hash-mark-size
|
|
|
3167 'efs-hash-mark-size)
|
|
|
3168 val)))))
|
|
|
3169
|
|
|
3170 (defun efs-process-handle-hash (str)
|
|
|
3171 ;; Remove hash marks from STRING and display count so far.
|
|
|
3172 (if (string-match "^#+$" str)
|
|
|
3173 (progn
|
|
|
3174 (setq efs-process-hash-mark-count
|
|
|
3175 (+ efs-process-hash-mark-count
|
|
|
3176 (- (match-end 0) (match-beginning 0))))
|
|
|
3177 (and
|
|
|
3178 efs-process-msg
|
|
|
3179 efs-process-hash-mark-unit
|
|
|
3180 (not (and efs-process-nowait
|
|
|
3181 (or (eq efs-verbose 0)
|
|
|
3182 (eq (selected-window) (minibuffer-window)))))
|
|
|
3183 (efs-message-p)
|
|
|
3184 (let* ((big (> efs-process-hash-mark-count 65536)) ; 2^16
|
|
|
3185 (kbytes (if big
|
|
|
3186 (* efs-process-hash-mark-unit
|
|
|
3187 (ash efs-process-hash-mark-count -6))
|
|
|
3188 (ash (* efs-process-hash-mark-unit
|
|
|
3189 efs-process-hash-mark-count)
|
|
|
3190 -6))))
|
|
|
3191 (if (zerop efs-process-xfer-size)
|
|
|
3192 (or (zerop kbytes)
|
|
|
3193 (efs-message "%s...%dk" efs-process-msg kbytes))
|
|
|
3194 (let ((percent (if big
|
|
|
3195 (/ (* 100 (ash kbytes -7))
|
|
|
3196 (ash efs-process-xfer-size -7))
|
|
|
3197 (/ (* 100 kbytes) efs-process-xfer-size))))
|
|
|
3198 ;; Don't display %'s betwwen 100 and 110
|
|
|
3199 (and (> percent 100) (< percent 110) (setq percent 100))
|
|
|
3200 ;; cut out the redisplay of identical %-age messages.
|
|
|
3201 (or (eq percent efs-process-last-percent)
|
|
|
3202 (progn
|
|
|
3203 (setq efs-process-last-percent percent)
|
|
|
3204 (efs-message "%s...%d%%" efs-process-msg percent)))))))
|
|
|
3205 (concat (substring str 0 (match-beginning 0))
|
|
|
3206 (and (/= (length str) (match-end 0))
|
|
|
3207 (substring str (1+ (match-end 0))))))
|
|
|
3208 str))
|
|
|
3209
|
|
|
3210 ;;;; ------------------------------------------------------------------
|
|
|
3211 ;;;; Keeping track of the number of active background connections.
|
|
|
3212 ;;;; ------------------------------------------------------------------
|
|
|
3213
|
|
|
3214 (defun efs-ftp-processes-active ()
|
|
|
3215 ;; Return the number of FTP processes busy.
|
|
|
3216 (save-excursion
|
|
|
3217 (length
|
|
|
3218 (delq nil
|
|
|
3219 (mapcar
|
|
|
3220 (function
|
|
|
3221 (lambda (buff)
|
|
|
3222 (set-buffer buff)
|
|
|
3223 (and (boundp 'efs-process-busy)
|
|
|
3224 efs-process-busy)))
|
|
|
3225 (buffer-list))))))
|
|
|
3226
|
|
|
3227 (defun efs-update-mode-line ()
|
|
|
3228 ;; Updates the mode with FTP activity, and runs `efs-ftp-activity-function'.
|
|
|
3229 (let ((num (efs-ftp-processes-active)))
|
|
|
3230 (if efs-mode-line-format
|
|
|
3231 (progn
|
|
|
3232 (if (zerop num)
|
|
|
3233 (setq efs-mode-line-string "")
|
|
|
3234 (setq efs-mode-line-string (format efs-mode-line-format num)))
|
|
|
3235 ;; fake emacs into re-calculating all the mode lines.
|
|
|
3236 (save-excursion (set-buffer (other-buffer)))
|
|
|
3237 (set-buffer-modified-p (buffer-modified-p))))
|
|
|
3238 (if efs-ftp-activity-function
|
|
|
3239 (funcall efs-ftp-activity-function num))))
|
|
|
3240
|
|
|
3241 (defun efs-display-ftp-activity ()
|
|
|
3242 "Displays the number of active background ftp sessions.
|
|
|
3243 Uses the variable `efs-mode-line-format' to determine how this will be
|
|
|
3244 displayed."
|
|
|
3245 (interactive)
|
|
|
3246 (or (memq 'efs-mode-line-string global-mode-string)
|
|
|
3247 (if global-mode-string
|
|
|
3248 (nconc global-mode-string '(efs-mode-line-string))
|
|
|
3249 (setq global-mode-string '("" efs-mode-line-string)))))
|
|
|
3250
|
|
|
3251 ;;;; -------------------------------------------------------------------
|
|
|
3252 ;;;; Expiring inactive ftp buffers.
|
|
|
3253 ;;;; -------------------------------------------------------------------
|
|
|
3254
|
|
|
3255 (defun efs-start-polling ()
|
|
|
3256 ;; Start polling FTP buffers, to look for idle ones.
|
|
|
3257 (or (null efs-expire-ftp-buffers)
|
|
|
3258 (let ((proc (get-process "efs poll")))
|
|
|
3259 (or (and proc (eq (process-status proc) 'run))))
|
|
|
3260 (let ((default-directory exec-directory)
|
|
|
3261 (process-connection-type nil)
|
|
|
3262 new-proc)
|
|
|
3263 (condition-case nil
|
|
|
3264 (delete-process "efs poll")
|
|
|
3265 (error nil))
|
|
|
3266 (setq new-proc (start-process
|
|
|
3267 "efs poll" nil
|
|
|
3268 (concat exec-directory "wakeup")
|
|
|
3269 (int-to-string efs-ftp-buffer-poll-time)))
|
|
|
3270 (set-process-filter new-proc (function efs-expire-ftp-buffers-filter))
|
|
|
3271 (process-kill-without-query new-proc))))
|
|
|
3272
|
|
|
3273 (defun efs-connection-visited-p (host user)
|
|
|
3274 ;; Returns t if there are any buffers visiting files on HOST and USER.
|
|
|
3275 (save-excursion
|
|
|
3276 (let ((list (buffer-list))
|
|
|
3277 (case-fold (memq (efs-host-type host)
|
|
|
3278 efs-case-insensitive-host-types))
|
|
|
3279 (visited nil)
|
|
|
3280 parsed)
|
|
|
3281 (setq host (downcase host))
|
|
|
3282 (if case-fold (setq user (downcase user)))
|
|
|
3283 (while list
|
|
|
3284 (set-buffer (car list))
|
|
|
3285 (if (or (and buffer-file-name
|
|
|
3286 (setq parsed (efs-ftp-path buffer-file-name))
|
|
|
3287 (string-equal host (downcase (car parsed)))
|
|
|
3288 (string-equal user (if case-fold
|
|
|
3289 (downcase (nth 1 parsed))
|
|
|
3290 (nth 1 parsed))))
|
|
|
3291 (and (boundp 'dired-directory)
|
|
|
3292 (stringp dired-directory)
|
|
|
3293 efs-dired-host-type
|
|
|
3294 (setq parsed (efs-ftp-path dired-directory))
|
|
|
3295 (string-equal host (downcase (car parsed)))
|
|
|
3296 (string-equal user (if case-fold
|
|
|
3297 (downcase (nth 1 parsed))
|
|
|
3298 (nth 1 parsed)))))
|
|
|
3299 (setq visited t
|
|
|
3300 list nil)
|
|
|
3301 (setq list (cdr list))))
|
|
|
3302 visited)))
|
|
|
3303
|
|
|
3304 (defun efs-expire-ftp-buffers-filter (proc string)
|
|
|
3305 ;; Check all ftp buffers, and kill them if they have been inactive
|
|
|
3306 ;; for the minimum of efs-ftp-buffer-expire-time and their local
|
|
|
3307 ;; time out time.
|
|
|
3308 (if efs-expire-ftp-buffers
|
|
|
3309 (let ((list (buffer-list))
|
|
|
3310 new-alist)
|
|
|
3311 (save-excursion
|
|
|
3312 (while list
|
|
|
3313 (set-buffer (car list))
|
|
|
3314 (if (eq major-mode 'efs-mode)
|
|
|
3315 (let* ((proc (get-buffer-process (current-buffer)))
|
|
|
3316 (proc-p (and proc (memq (process-status proc)
|
|
|
3317 '(run open)))))
|
|
|
3318 (if (or efs-ftp-buffer-expire-time
|
|
|
3319 efs-process-idle-time
|
|
|
3320 (null proc-p))
|
|
|
3321 (let ((elt (assq (car list) efs-ftp-buffer-alist))
|
|
|
3322 (wind-p (get-buffer-window (car list))))
|
|
|
3323 (if (or (null elt) (buffer-modified-p)
|
|
|
3324 efs-process-busy wind-p)
|
|
|
3325 (progn
|
|
|
3326 (setq new-alist (cons (cons (car list) 0)
|
|
|
3327 new-alist))
|
|
|
3328 (or wind-p (set-buffer-modified-p nil)))
|
|
|
3329 (let ((idle (+ (cdr elt)
|
|
|
3330 efs-ftp-buffer-poll-time)))
|
|
|
3331 (if (and proc-p
|
|
|
3332 (< idle
|
|
|
3333 (if efs-ftp-buffer-expire-time
|
|
|
3334 (if efs-process-idle-time
|
|
|
3335 (min efs-ftp-buffer-expire-time
|
|
|
3336 efs-process-idle-time)
|
|
|
3337 efs-ftp-buffer-expire-time)
|
|
|
3338 efs-process-idle-time)))
|
|
|
3339 (progn
|
|
|
3340 (setq new-alist (cons (cons (car list) idle)
|
|
|
3341 new-alist))
|
|
|
3342 (set-buffer-modified-p nil))
|
|
|
3343 ;; If there are still buffers for host & user,
|
|
|
3344 ;; don't wipe the cache.
|
|
|
3345 (and proc
|
|
|
3346 (efs-connection-visited-p
|
|
|
3347 efs-process-host efs-process-user)
|
|
|
3348 (set-process-sentinel proc nil))
|
|
|
3349 (kill-buffer (car list)))))))))
|
|
|
3350 (setq list (cdr list))))
|
|
|
3351 (setq efs-ftp-buffer-alist new-alist))
|
|
|
3352 (condition-case nil
|
|
|
3353 (delete-process "efs poll")
|
|
|
3354 (error nil))))
|
|
|
3355
|
|
|
3356 ;;;; -------------------------------------------------------------------
|
|
|
3357 ;;;; When the FTP client process dies...
|
|
|
3358 ;;;; -------------------------------------------------------------------
|
|
|
3359
|
|
|
3360 (defun efs-process-sentinel (proc str)
|
|
|
3361 ;; When ftp process changes state, nuke all file-entries in cache.
|
|
|
3362 (let ((buff (process-buffer proc)))
|
|
|
3363 ;; If the client dies, make sure that efs doesn't think that
|
|
|
3364 ;; there is a running process.
|
|
|
3365 (save-excursion
|
|
|
3366 (condition-case nil
|
|
|
3367 (progn
|
|
|
3368 (set-buffer buff)
|
|
|
3369 (setq efs-process-busy nil))
|
|
|
3370 (error nil)))
|
|
|
3371 (let ((parsed (efs-parse-proc-name proc)))
|
|
|
3372 (if parsed
|
|
|
3373 (progn
|
|
|
3374 (apply 'efs-wipe-file-entries parsed)
|
|
|
3375 (apply 'efs-wipe-from-ls-cache parsed))))
|
|
|
3376 (if (or efs-mode-line-format efs-ftp-activity-function)
|
|
|
3377 (efs-update-mode-line))))
|
|
|
3378
|
|
|
3379 (defun efs-kill-ftp-process (buffer)
|
|
|
3380 "Kill an FTP connection and its associated process buffer.
|
|
|
3381 If the BUFFER's visited file name or default-directory is an efs remote
|
|
|
3382 file name, it is the connection for that file name that is killed."
|
|
|
3383 (interactive "bKill FTP process associated with buffer: ")
|
|
|
3384 (or buffer (setq buffer (current-buffer)))
|
|
|
3385 (save-excursion
|
|
|
3386 (set-buffer buffer)
|
|
|
3387 (if (eq major-mode 'efs-mode)
|
|
|
3388 (kill-buffer buffer)
|
|
|
3389 (let ((file (or (buffer-file-name) default-directory)))
|
|
|
3390 (if file
|
|
|
3391 (let ((parsed (efs-ftp-path (expand-file-name file))))
|
|
|
3392 (if parsed
|
|
|
3393 (let ((host (nth 0 parsed))
|
|
|
3394 (user (nth 1 parsed)))
|
|
|
3395 (kill-buffer
|
|
|
3396 (efs-ftp-process-buffer host user))))))))))
|
|
|
3397
|
|
|
3398 (defun efs-close-ftp-process (buffer)
|
|
|
3399 "Close an FTP connection.
|
|
|
3400 This kills the FTP client process, but unlike `efs-kill-ftp-process' this
|
|
|
3401 neither kills the process buffer, nor deletes cached data for the connection."
|
|
|
3402 (interactive "bClose FTP process associated with buffer: ")
|
|
|
3403 (or buffer (setq buffer (current-buffer)))
|
|
|
3404 (save-excursion
|
|
|
3405 (set-buffer buffer)
|
|
|
3406 (if (eq major-mode 'efs-mode)
|
|
|
3407 (let ((process (get-buffer-process buffer)))
|
|
|
3408 (if process
|
|
|
3409 (progn
|
|
|
3410 (set-process-sentinel process nil)
|
|
|
3411 (setq efs-process-busy nil
|
|
|
3412 efs-process-q nil)
|
|
|
3413 (if (or efs-mode-line-format efs-ftp-activity-function)
|
|
|
3414 (efs-update-mode-line))
|
|
|
3415 (delete-process process))))
|
|
|
3416 (let ((file (or (buffer-file-name) default-directory)))
|
|
|
3417 (if file
|
|
|
3418 (let ((parsed (efs-ftp-path (expand-file-name file))))
|
|
|
3419 (if parsed
|
|
|
3420 (let ((process (get-process
|
|
|
3421 (format "*ftp %s@%s*"
|
|
|
3422 (nth 1 parsed) (car parsed)))))
|
|
|
3423 (if process
|
|
|
3424 (progn
|
|
|
3425 (set-buffer (process-buffer process))
|
|
|
3426 (set-process-sentinel process nil)
|
|
|
3427 (setq efs-process-busy nil
|
|
|
3428 efs-process-q nil)
|
|
|
3429 (if (or efs-mode-line-format
|
|
|
3430 efs-ftp-activity-function)
|
|
|
3431 (efs-update-mode-line))
|
|
|
3432 (delete-process process)))))))))))
|
|
|
3433
|
|
|
3434 (defun efs-ping-ftp-connection (buffer)
|
|
|
3435 "Ping a connection by sending a NOOP command.
|
|
|
3436 Useful for waking up a possible expired connection."
|
|
|
3437 (interactive "bPing FTP connection associated with buffer: ")
|
|
|
3438 (or buffer (setq buffer (current-buffer)))
|
|
|
3439 (efs-save-buffer-excursion
|
|
|
3440 (set-buffer buffer)
|
|
|
3441 (let (file host user parsed)
|
|
|
3442 (if (or (and (eq major-mode 'efs-mode)
|
|
|
3443 (setq host efs-process-host
|
|
|
3444 user efs-process-user))
|
|
|
3445 (and (setq file (or (buffer-file-name) default-directory))
|
|
|
3446 (setq parsed (efs-ftp-path file))
|
|
|
3447 (setq host (car parsed)
|
|
|
3448 user (nth 1 parsed))))
|
|
|
3449 (or (car
|
|
|
3450 (efs-send-cmd
|
|
|
3451 host user '(quote noop)
|
|
|
3452 (format "Pinging connection %s@%s" user host)))
|
|
|
3453 (message "Connection %s@%s is alive." user host))))))
|
|
|
3454
|
|
|
3455 (defun efs-display-ftp-process-buffer (buffer)
|
|
|
3456 "Displays the FTP process buffer associated with the current buffer."
|
|
|
3457 (interactive "bDisplay FTP buffer associated with buffer: ")
|
|
|
3458 (if (null buffer) (setq buffer (current-buffer)))
|
|
|
3459 (let ((file (or (buffer-file-name) default-directory))
|
|
|
3460 parsed proc-buffer)
|
|
|
3461 (if (and file (setq parsed (efs-ftp-path file))
|
|
|
3462 (setq proc-buffer (get-buffer (efs-ftp-process-buffer
|
|
|
3463 (car parsed)
|
|
|
3464 (nth 1 parsed)))))
|
|
|
3465 (display-buffer proc-buffer)
|
|
|
3466 (error "Buffer %s not associated with an FTP process" buffer))))
|
|
|
3467
|
|
|
3468 ;;;; -------------------------------------------------------------------
|
|
|
3469 ;;;; Starting the FTP client process
|
|
|
3470 ;;;; -------------------------------------------------------------------
|
|
|
3471
|
|
|
3472 (defun efs-ftp-process-buffer (host user)
|
|
|
3473 "Return name of the process buffer for ftp process for HOST and USER."
|
|
|
3474 ;; Host names on the internet are case-insensitive.
|
|
|
3475 (format efs-ftp-buffer-format user (downcase host)))
|
|
|
3476
|
|
|
3477 (defun efs-pty-check (proc threshold)
|
|
|
3478 ;; Checks to see if PROC is a pty. Beware, it clobbers the process
|
|
|
3479 ;; filter, so run this before you set the filter.
|
|
|
3480 ;; THRESHOLD is an integer to tell it how long to wait for output.
|
|
|
3481 (sit-for 0) ; Update the display before doing any waiting.
|
|
|
3482 (let ((efs-pipe-p t)
|
|
|
3483 (n 0))
|
|
|
3484 (set-process-filter proc (function (lambda (proc string)
|
|
|
3485 (setq efs-pipe-p nil))))
|
|
|
3486 (while (and (< n threshold) efs-pipe-p)
|
|
|
3487 (accept-process-output)
|
|
|
3488 (setq n (1+ n)))
|
|
|
3489 (if efs-pipe-p
|
|
|
3490 (progn
|
|
|
3491 (sit-for 0) ; update display
|
|
|
3492 ;; Use a sleep-for as I don't want pty-checking to depend
|
|
|
3493 ;; on pending input.
|
|
|
3494 (sleep-for efs-pty-check-retry-time)))
|
|
|
3495 (accept-process-output)
|
|
|
3496 (if efs-pipe-p
|
|
|
3497 (if (or noninteractive
|
|
|
3498 (progn
|
|
|
3499 ;; in case the user typed something during the wait.
|
|
|
3500 (discard-input)
|
|
|
3501 (y-or-n-p
|
|
|
3502 (format "%s seems not a pty. Kill? " proc))))
|
|
|
3503 (progn
|
|
|
3504 (kill-buffer (process-buffer proc))
|
|
|
3505 (if (eq (selected-window) (minibuffer-window))
|
|
|
3506 (abort-recursive-edit)
|
|
|
3507 (signal 'quit nil))))
|
|
|
3508 ;; Need to send a \n to make sure, because sometimes we get the startup
|
|
|
3509 ;; prompt from a pipe.
|
|
|
3510 (sit-for 0)
|
|
|
3511 (process-send-string proc "\n")
|
|
|
3512 (setq efs-pipe-p t
|
|
|
3513 n 0)
|
|
|
3514 (while (and (< n threshold) efs-pipe-p)
|
|
|
3515 (accept-process-output)
|
|
|
3516 (setq n (1+ n)))
|
|
|
3517 (if efs-pipe-p
|
|
|
3518 (progn
|
|
|
3519 (sit-for 0)
|
|
|
3520 (sleep-for efs-pty-check-retry-time)))
|
|
|
3521 (accept-process-output)
|
|
|
3522 (if (and efs-pipe-p
|
|
|
3523 (or noninteractive
|
|
|
3524 (progn
|
|
|
3525 ;; in case the user typed something during the wait.
|
|
|
3526 (discard-input)
|
|
|
3527 (y-or-n-p
|
|
|
3528 (format "%s seems not a pty. Kill? " proc)))))
|
|
|
3529 (progn
|
|
|
3530 (kill-buffer (process-buffer proc))
|
|
|
3531 (if (eq (selected-window) (minibuffer-window))
|
|
|
3532 (abort-recursive-edit)
|
|
|
3533 (signal 'quit nil)))))))
|
|
|
3534
|
|
|
3535 (defun efs-start-process (host user name)
|
|
|
3536 "Spawn a new ftp process ready to connect to machine HOST as USER.
|
|
|
3537 If HOST is only ftp-able through a gateway machine then spawn a shell
|
|
|
3538 on the gateway machine to do the ftp instead. NAME is the name of the
|
|
|
3539 process."
|
|
|
3540 (let* ((use-gateway (efs-use-gateway-p host))
|
|
|
3541 (buffer (get-buffer-create (efs-ftp-process-buffer host user)))
|
|
|
3542 (process-connection-type t)
|
|
|
3543 (opaque-p (memq use-gateway efs-opaque-gateways))
|
|
|
3544 proc)
|
|
|
3545 (save-excursion
|
|
|
3546 (set-buffer buffer)
|
|
|
3547 (efs-mode host user (if opaque-p
|
|
|
3548 efs-gateway-ftp-prompt-regexp
|
|
|
3549 efs-ftp-prompt-regexp)))
|
|
|
3550 (cond
|
|
|
3551 ((null use-gateway)
|
|
|
3552 (message "Opening FTP connection to %s..." host)
|
|
|
3553 (setq proc (apply 'start-process name buffer efs-ftp-program-name
|
|
|
3554 efs-ftp-program-args)))
|
|
|
3555 ((eq use-gateway 'interactive)
|
|
|
3556 (setq proc (efs-gwp-start host user name)))
|
|
|
3557 ((eq use-gateway 'remsh)
|
|
|
3558 (message "Opening FTP connection to %s via %s..." host efs-gateway-host)
|
|
|
3559 (setq proc (apply 'start-process name buffer (nth 1 efs-gateway-type)
|
|
|
3560 (append (list efs-gateway-host)
|
|
|
3561 (nth 2 efs-gateway-type)
|
|
|
3562 (list (nth 3 efs-gateway-type))
|
|
|
3563 (nth 4 efs-gateway-type)))))
|
|
|
3564 ((memq use-gateway '(proxy raptor interlock kerberos))
|
|
|
3565 (message "Opening FTP connection to %s via %s..." host efs-gateway-host)
|
|
|
3566 (setq proc (apply 'start-process name buffer (nth 1 efs-gateway-type)
|
|
|
3567 (nth 2 efs-gateway-type))))
|
|
|
3568 ((eq use-gateway 'local)
|
|
|
3569 (message "Opening FTP connection to %s..." host)
|
|
|
3570 (setq proc (apply 'start-process name buffer (nth 1 efs-gateway-type)
|
|
|
3571 (nth 2 efs-gateway-type))))
|
|
|
3572 ((error "Never heard of gateway type %s" use-gateway)))
|
|
|
3573 (process-kill-without-query proc)
|
|
|
3574 (if opaque-p
|
|
|
3575 (accept-process-output proc)
|
|
|
3576 (if efs-pty-check-threshold
|
|
|
3577 (efs-pty-check proc efs-pty-check-threshold)
|
|
|
3578 (accept-process-output proc)))
|
|
|
3579 (set-process-sentinel proc (function efs-process-sentinel))
|
|
|
3580 (set-process-filter proc (function efs-process-filter))
|
|
|
3581 (efs-start-polling)
|
|
|
3582 (save-excursion
|
|
|
3583 (set-buffer buffer)
|
|
|
3584 (goto-char (point-max))
|
|
|
3585 (set-marker (process-mark proc) (point)))
|
|
|
3586 proc))
|
|
|
3587
|
|
|
3588 (defun efs-get-process-internal (host user)
|
|
|
3589 ;; Get's the first process for HOST and USER. If HOST runs a
|
|
|
3590 ;; a case insignificant OS, then case is not considered in USER.
|
|
|
3591 (let ((list (process-list))
|
|
|
3592 (case-fold (memq (efs-host-type host)
|
|
|
3593 efs-case-insensitive-host-types))
|
|
|
3594 (len (+ (length host) (length user) 7))
|
|
|
3595 fmt name found)
|
|
|
3596 (setq host (downcase host))
|
|
|
3597 (if case-fold (setq user (downcase user)))
|
|
|
3598 (while (and (not found) list)
|
|
|
3599 (setq name (process-name (car list)))
|
|
|
3600 (if (and (= (length name) len)
|
|
|
3601 (string-equal (substring name 0 5) "*ftp ")
|
|
|
3602 (string-equal
|
|
|
3603 (if case-fold (downcase (substring name 5)) (substring name 5))
|
|
|
3604 (or fmt (setq fmt (format "%s@%s*" user host))))
|
|
|
3605 (memq (process-status (car list)) '(run open)))
|
|
|
3606 (setq found (car list))
|
|
|
3607 (setq list (cdr list))))
|
|
|
3608 found))
|
|
|
3609
|
|
|
3610 ;; efs-guess-host-type calls this
|
|
|
3611 ;; function recursively. The (if (and proc... avoids an infinite
|
|
|
3612 ;; loop. We should make sure that this won't hang things if the
|
|
|
3613 ;; connection goes wrong.
|
|
|
3614
|
|
|
3615 (defun efs-get-process (host user)
|
|
|
3616 "Return the process object for the FTP process for HOST and USER.
|
|
|
3617 Create a new process if needed."
|
|
|
3618
|
|
|
3619 (let ((proc (efs-get-process-internal host user)))
|
|
|
3620 (if (and proc (memq (process-status proc) '(run open)))
|
|
|
3621 proc
|
|
|
3622
|
|
|
3623 ;; Make sure that the process isn't around in some strange state.
|
|
|
3624
|
|
|
3625 (setq host (downcase host))
|
|
|
3626 (let ((name (concat "*ftp " user "@" host "*")))
|
|
|
3627 (if proc (condition-case nil (delete-process proc) (error nil)))
|
|
|
3628
|
|
|
3629 ;; grab a suitable process.
|
|
|
3630 (setq proc (efs-start-process host user name))
|
|
|
3631
|
|
|
3632 (efs-save-match-data
|
|
|
3633 (efs-save-buffer-excursion
|
|
|
3634 (set-buffer (process-buffer proc))
|
|
|
3635
|
|
|
3636 ;; Run any user-specified hooks.
|
|
|
3637 (run-hooks 'efs-ftp-startup-hook)
|
|
|
3638
|
|
|
3639 ;; login to FTP server.
|
|
|
3640 (efs-login host user proc)
|
|
|
3641
|
|
|
3642 ;; Beware, the process may have died if the login went bad.
|
|
|
3643 (if (memq (process-status proc) '(run open))
|
|
|
3644
|
|
|
3645 (progn
|
|
|
3646 ;; Tell client to send back hash-marks as progress. It isn't
|
|
|
3647 ;; usually fatal if this command fails.
|
|
|
3648 (efs-guess-hash-mark-size proc)
|
|
|
3649
|
|
|
3650 ;; Run any user startup functions
|
|
|
3651 (let ((alist efs-ftp-startup-function-alist)
|
|
|
3652 (case-fold-search t))
|
|
|
3653 (while alist
|
|
|
3654 (if (string-match (car (car alist)) host)
|
|
|
3655 (progn
|
|
|
3656 (funcall (cdr (car alist)) host user)
|
|
|
3657 (setq alist nil))
|
|
|
3658 (setq alist (cdr alist)))))
|
|
|
3659
|
|
|
3660 ;; Guess at the host type.
|
|
|
3661 (efs-guess-host-type host user)
|
|
|
3662
|
|
|
3663 ;; Check the idle time.
|
|
|
3664 (efs-check-idle host user)
|
|
|
3665
|
|
|
3666 proc)
|
|
|
3667
|
|
|
3668 ;; Hopefully a recursive retry worked.
|
|
|
3669 (or (efs-get-process-internal host user)
|
|
|
3670 (error "No FTP process for %s@%s" user host)))))))))
|
|
|
3671
|
|
|
3672 (defun efs-guess-hash-mark-size (proc)
|
|
|
3673 ;; Doesn't run efs-save-match-data. You must do that yourself.
|
|
|
3674 (if efs-send-hash
|
|
|
3675 (save-excursion
|
|
|
3676 (set-buffer (process-buffer proc))
|
|
|
3677 (let ((line (nth 1 (efs-raw-send-cmd proc "hash")))
|
|
|
3678 (gate-p (efs-use-gateway-p efs-process-host t)))
|
|
|
3679 ;; Don't guess if the hash-mark-size is already set.
|
|
|
3680 (or (if gate-p efs-gateway-hash-mark-size efs-hash-mark-size)
|
|
|
3681 (if (string-match efs-hash-mark-msgs line)
|
|
|
3682 (let ((size (substring line (match-beginning 1)
|
|
|
3683 (match-end 1))))
|
|
|
3684 (if (string-match "^[0-9]+$" size)
|
|
|
3685 (set (if gate-p
|
|
|
3686 'efs-gateway-hash-mark-size
|
|
|
3687 'efs-hash-mark-size)
|
|
|
3688 (string-to-int size))))))))))
|
|
|
3689
|
|
|
3690 ;;;; ------------------------------------------------------------
|
|
|
3691 ;;;; Simple FTP process shell support.
|
|
|
3692 ;;;; ------------------------------------------------------------
|
|
|
3693
|
|
|
3694 (defun efs-mode (host user prompt)
|
|
|
3695 "Major mode for interacting with an FTP process.
|
|
|
3696 The user interface for sending commands to the FTP process is `comint-mode'.
|
|
|
3697 For more information see the documentation for `comint-mode'. This command
|
|
|
3698 is not intended for interactive use.
|
|
|
3699 Takes arguments: HOST USER PROMPT
|
|
|
3700
|
|
|
3701 Runs efs-mode-hook if it is not nil.
|
|
|
3702
|
|
|
3703 Key map:
|
|
|
3704 \\{comint-mode-map}"
|
|
|
3705 (let ((proc (get-buffer-process (current-buffer))))
|
|
|
3706 ;; Running comint-mode will kill-all-local-variables.
|
|
|
3707 (comint-mode)
|
|
|
3708 ;; All these variables are buffer local.
|
|
|
3709 (setq major-mode 'efs-mode
|
|
|
3710 mode-name "efs"
|
|
|
3711 default-directory (file-name-directory efs-tmp-name-template)
|
|
|
3712 comint-prompt-regexp prompt
|
|
|
3713 efs-process-host host
|
|
|
3714 efs-process-user user
|
|
|
3715 efs-process-prompt-regexp prompt)
|
|
|
3716 (set (make-local-variable 'paragraph-start) comint-prompt-regexp)
|
|
|
3717 ;; Old versions of comint don't have this. It does no harm for
|
|
|
3718 ;; the newer ones.
|
|
|
3719 (set (make-local-variable 'comint-last-input-start) (make-marker))
|
|
|
3720 (goto-char (point-max))
|
|
|
3721 ;; in case there is a running process
|
|
|
3722 (if proc (set-marker (process-mark proc) (point)))
|
|
|
3723 (run-hooks 'efs-mode-hook)))
|
|
|
3724
|
|
|
3725
|
|
|
3726 ;;;; =============================================================
|
|
|
3727 ;;;; >6
|
|
|
3728 ;;;; Sending commands to the FTP server.
|
|
|
3729 ;;;; =============================================================
|
|
|
3730
|
|
|
3731 ;;;; -------------------------------------------------------------
|
|
|
3732 ;;;; General purpose functions for sending commands.
|
|
|
3733 ;;;; -------------------------------------------------------------
|
|
|
3734
|
|
|
3735 (defun efs-raw-send-cmd (proc cmd &optional msg pre-cont cont nowait)
|
|
|
3736 ;; Low-level routine to send the given ftp CMD to the ftp PROCESS.
|
|
|
3737 ;; MSG is an optional message to output before and after the command.
|
|
|
3738 ;; If PRE-CONT is non-nil, it is called immediately after execution
|
|
|
3739 ;; of the command starts, but without waiting for it to finish.
|
|
|
3740 ;; If CONT is non-NIL then it is either a function or a list of function and
|
|
|
3741 ;; some arguments. The function will be called when the ftp command has
|
|
|
3742 ;; completed.
|
|
|
3743 ;; If CONT is NIL then this routine will return \( RESULT . LINE \) where
|
|
|
3744 ;; RESULT is whether the command was successful, and LINE is the line from
|
|
|
3745 ;; the FTP process that caused the command to complete.
|
|
|
3746 ;; If NOWAIT is nil then we will wait for the command to complete before
|
|
|
3747 ;; returning. If NOWAIT is 0, then we will wait until the command starts,
|
|
|
3748 ;; executing before returning. NOWAIT of 1 is like 0, except that the modeline
|
|
|
3749 ;; will indicate an asynch FTP command.
|
|
|
3750 ;; If NOWAIT has any other value, then we will simply queue the
|
|
|
3751 ;; command. In all cases, CONT will still be called
|
|
|
3752
|
|
|
3753 (if (memq (process-status proc) '(run open))
|
|
|
3754 (efs-save-buffer-excursion
|
|
|
3755 (set-buffer (process-buffer proc))
|
|
|
3756
|
|
|
3757 (if efs-process-busy
|
|
|
3758 ;; This function will always wait on a busy process.
|
|
|
3759 ;; Queueing is done by efs-send-cmd.
|
|
|
3760 (let ((efs-process-cmd-waiting t))
|
|
|
3761 (efs-kbd-quit-protect proc
|
|
|
3762 (while efs-process-busy
|
|
|
3763 (accept-process-output)))))
|
|
|
3764
|
|
|
3765 (setq efs-process-string ""
|
|
|
3766 efs-process-result-line ""
|
|
|
3767 efs-process-result-cont-lines ""
|
|
|
3768 efs-process-busy t
|
|
|
3769 efs-process-msg (and efs-verbose msg)
|
|
|
3770 efs-process-continue cont
|
|
|
3771 efs-process-server-confused nil
|
|
|
3772 efs-process-nowait nowait
|
|
|
3773 efs-process-hash-mark-count 0
|
|
|
3774 efs-process-last-percent -1
|
|
|
3775 efs-process-xfer-size 0
|
|
|
3776 efs-process-cmd-counter (% (1+ efs-process-cmd-counter) 16))
|
|
|
3777 (process-kill-without-query proc t)
|
|
|
3778 (and efs-process-msg
|
|
|
3779 (efs-message-p)
|
|
|
3780 (efs-message "%s..." efs-process-msg))
|
|
|
3781 (goto-char (point-max))
|
|
|
3782 (move-marker comint-last-input-start (point))
|
|
|
3783 (move-marker comint-last-input-end (point))
|
|
|
3784 ;; don't insert the password into the buffer on the USER command.
|
|
|
3785 (efs-save-match-data
|
|
|
3786 (if (string-match efs-passwd-cmds cmd)
|
|
|
3787 (insert (setq efs-process-cmd
|
|
|
3788 (substring cmd 0 (match-end 0)))
|
|
|
3789 " Turtle Power!\n")
|
|
|
3790 (setq efs-process-cmd cmd)
|
|
|
3791 (insert cmd "\n")))
|
|
|
3792 (process-send-string proc (concat cmd "\n"))
|
|
|
3793 (set-marker (process-mark proc) (point))
|
|
|
3794 ;; Update the mode-line
|
|
|
3795 (if (and (or efs-mode-line-format efs-ftp-activity-function)
|
|
|
3796 (memq nowait '(t 1)))
|
|
|
3797 (efs-update-mode-line))
|
|
|
3798 (if pre-cont
|
|
|
3799 (let ((efs-nested-cmd t))
|
|
|
3800 (save-excursion
|
|
|
3801 (apply (car pre-cont) (cdr pre-cont)))))
|
|
|
3802 (prog1
|
|
|
3803 (if nowait
|
|
|
3804 nil
|
|
|
3805 ;; hang around for command to complete
|
|
|
3806 ;; Some clients die after the command is sent, if the server
|
|
|
3807 ;; times out. Don't wait on dead processes.
|
|
|
3808 (efs-kbd-quit-protect proc
|
|
|
3809 (while (and efs-process-busy
|
|
|
3810 ;; Need to recheck nowait, since it may get reset
|
|
|
3811 ;; in a cont.
|
|
|
3812 (null efs-process-nowait)
|
|
|
3813 (memq (process-status proc) '(run open)))
|
|
|
3814 (accept-process-output proc)))
|
|
|
3815
|
|
|
3816 ;; cont is called by the process filter
|
|
|
3817 (if cont
|
|
|
3818 ;; Return nil if a cont was called.
|
|
|
3819 ;; Can't return process-result
|
|
|
3820 ;; and process-line since executing
|
|
|
3821 ;; the cont may have changed
|
|
|
3822 ;; the state of the process buffer.
|
|
|
3823 nil
|
|
|
3824 (list efs-process-result
|
|
|
3825 efs-process-result-line
|
|
|
3826 efs-process-result-cont-lines)))
|
|
|
3827
|
|
|
3828 ;; If the process died, the filter would have never got the chance
|
|
|
3829 ;; to call the cont. Try to jump start things.
|
|
|
3830
|
|
|
3831 (if (and (not (memq (process-status proc) '(run open)))
|
|
|
3832 (string-equal efs-process-result-line "")
|
|
|
3833 cont
|
|
|
3834 (equal cont efs-process-continue))
|
|
|
3835 (progn
|
|
|
3836 (setq efs-process-continue nil
|
|
|
3837 efs-process-busy nil)
|
|
|
3838 ;; The process may be in some strange state. Get rid of it.
|
|
|
3839 (condition-case nil (delete-process proc) (error nil))
|
|
|
3840 (efs-call-cont cont 'fatal "" "")))))
|
|
|
3841
|
|
|
3842 (error "FTP process %s has died." (process-name proc))))
|
|
|
3843
|
|
|
3844 (efs-defun efs-quote-string nil (string &optional not-space)
|
|
|
3845 "Quote any characters in STRING that may confuse the ftp process.
|
|
|
3846 If NOT-SPACE is non-nil, then blank characters are not quoted, because
|
|
|
3847 it is assumed that the string will be surrounded by \"'s."
|
|
|
3848 (apply (function concat)
|
|
|
3849 (mapcar (function
|
|
|
3850 (lambda (char)
|
|
|
3851 (if (or (< char ?\ )
|
|
|
3852 (and (null not-space) (= char ?\ ))
|
|
|
3853 (> char ?\~)
|
|
|
3854 (= char ?\")
|
|
|
3855 (= char ?\\))
|
|
|
3856 (vector ?\\ char)
|
|
|
3857 (vector char))))
|
|
|
3858 string)))
|
|
|
3859
|
|
|
3860 (efs-defun efs-fix-path nil (path &optional reverse)
|
|
|
3861 "Convert PATH from a unix format to a non-unix format.
|
|
|
3862 If optional REVERSE, convert in the opposite direction."
|
|
|
3863 (identity path))
|
|
|
3864
|
|
|
3865 (efs-defun efs-fix-dir-path nil (dir-path)
|
|
|
3866 "Convert DIR-PATH from unix format to a non-unix format for a dir listing"
|
|
|
3867 ;; The default def runs for dos-distinct, ka9q, and all the unix's.
|
|
|
3868 ;; To be more careful about distinguishing dirs from plain files,
|
|
|
3869 ;; we append a ".".
|
|
|
3870 (let ((len (length dir-path)))
|
|
|
3871 (if (and (not (zerop len)) (= (aref dir-path (1- len)) ?/))
|
|
|
3872 (concat dir-path ".")
|
|
|
3873 dir-path)))
|
|
|
3874
|
|
|
3875 (defun efs-send-cmd (host user cmd
|
|
|
3876 &optional msg pre-cont cont nowait noretry)
|
|
|
3877 "Find an ftp process connected to HOST logged in as USER and send it CMD.
|
|
|
3878 MSG is an optional status message to be output before and after issuing the
|
|
|
3879 command.
|
|
|
3880
|
|
|
3881 See the documentation for efs-raw-send-cmd for a description of CONT, PRE-CONT
|
|
|
3882 and NOWAIT. Normally, if the command fails it is retried. If NORETRY is
|
|
|
3883 non-nil, this is not done."
|
|
|
3884 ;; Handles conversion to remote pathname syntax and remote ls option
|
|
|
3885 ;; capability. Also, sends umask if nec.
|
|
|
3886
|
|
|
3887 (let ((proc (efs-get-process host user)))
|
|
|
3888
|
|
|
3889 (if (and
|
|
|
3890 (eq nowait t)
|
|
|
3891 (save-excursion
|
|
|
3892 (set-buffer (process-buffer proc))
|
|
|
3893 (or efs-process-busy
|
|
|
3894 efs-process-cmd-waiting)))
|
|
|
3895
|
|
|
3896 (progn
|
|
|
3897 (efs-add-to-queue
|
|
|
3898 host user
|
|
|
3899 ;; Not nec. to store host and user, because the queue is for
|
|
|
3900 ;; a specific host user pair anyway. Because the queue is always
|
|
|
3901 ;; examined when efs-process-busy
|
|
|
3902 ;; is nil, it should be impossible to get into a loop
|
|
|
3903 ;; where we keep re-queueing over and over. To be on the safe
|
|
|
3904 ;; side, store nowait as 1.
|
|
|
3905 (list cmd msg pre-cont cont 1 noretry))
|
|
|
3906 nil)
|
|
|
3907
|
|
|
3908 ;; Send a command.
|
|
|
3909
|
|
|
3910 (let (cmd-string afsc-result afsc-line afsc-cont-lines)
|
|
|
3911
|
|
|
3912 (let ((efs-nested-cmd t)
|
|
|
3913 (cmd0 (car cmd))
|
|
|
3914 (cmd1 (nth 1 cmd))
|
|
|
3915 (cmd2 (nth 2 cmd))
|
|
|
3916 (cmd3 (nth 3 cmd)))
|
|
|
3917
|
|
|
3918 (cond
|
|
|
3919
|
|
|
3920 ((eq cmd0 'quote)
|
|
|
3921 ;; QUOTEd commands
|
|
|
3922 (cond
|
|
|
3923
|
|
|
3924 ((eq cmd1 'site)
|
|
|
3925 ;; SITE commands
|
|
|
3926 (cond
|
|
|
3927 ((memq cmd2 '(umask idle dos exec nfs group gpass))
|
|
|
3928 ;; For UMASK cmd3 = value of umask
|
|
|
3929 ;; For IDLE cmd3 = idle setting, or nil if we're querying.
|
|
|
3930 ;; For DOS and NFS cmd3 is nil.
|
|
|
3931 ;; For EXEC cmd3 is the command to be exec'ed -- a string.
|
|
|
3932 (if cmd3 (setq cmd3 (concat " " cmd3)))
|
|
|
3933 (setq cmd-string (concat "quote site " (symbol-name cmd2)
|
|
|
3934 cmd3)))
|
|
|
3935 ((eq cmd2 'chmod)
|
|
|
3936 (let* ((host-type (efs-host-type host user))
|
|
|
3937 (cmd4 (efs-quote-string
|
|
|
3938 host-type (efs-fix-path host-type (nth 4 cmd)))))
|
|
|
3939 (setq cmd-string (concat "quote site chmod " cmd3 " "
|
|
|
3940 cmd4))))
|
|
|
3941 (t (error "efs: Don't know how to send %s %s %s %s"
|
|
|
3942 cmd0 cmd1 cmd2 cmd3))))
|
|
|
3943
|
|
|
3944 ((memq cmd1 '(pwd xpwd syst pasv noop))
|
|
|
3945 (setq cmd-string (concat "quote " (symbol-name cmd1))))
|
|
|
3946
|
|
|
3947 ;; PORT command (cmd2 is IP + port address)
|
|
|
3948 ((eq cmd1 'port)
|
|
|
3949 (setq cmd-string (concat "quote port " cmd2)))
|
|
|
3950
|
|
|
3951 ((memq cmd1 '(appe retr))
|
|
|
3952 (let ((host-type (efs-host-type host user)))
|
|
|
3953 ;; Set an xfer type
|
|
|
3954 (if cmd3 (efs-set-xfer-type host user cmd3 t))
|
|
|
3955 (setq cmd2 (efs-quote-string host-type
|
|
|
3956 (efs-fix-path host-type cmd2))
|
|
|
3957 cmd-string (concat "quote " (symbol-name cmd1) " "
|
|
|
3958 cmd2))))
|
|
|
3959
|
|
|
3960 ((eq cmd1 'stor)
|
|
|
3961 (let ((host-type (efs-host-type host user)))
|
|
|
3962 (if (memq host-type efs-unix-host-types)
|
|
|
3963 (efs-set-umask host user))
|
|
|
3964 ;; Set an xfer type
|
|
|
3965 (if cmd3 (efs-set-xfer-type host user cmd3 t))
|
|
|
3966 (setq cmd2 (efs-quote-string host-type
|
|
|
3967 (efs-fix-path host-type cmd2))
|
|
|
3968 cmd-string (concat "quote stor " cmd2))))
|
|
|
3969
|
|
|
3970 ((memq cmd1 '(size mdtm rnfr))
|
|
|
3971 (let ((host-type (efs-host-type host user)))
|
|
|
3972 (setq cmd2 (efs-quote-string host-type
|
|
|
3973 (efs-fix-path host-type cmd2))
|
|
|
3974 cmd-string (concat "quote "
|
|
|
3975 (symbol-name cmd1) " " cmd2))))
|
|
|
3976
|
|
|
3977 ((memq cmd1 '(pass user))
|
|
|
3978 (setq cmd-string (concat "quote " (symbol-name cmd1) " " cmd2)))
|
|
|
3979
|
|
|
3980 (t
|
|
|
3981 (error "efs: Don't know how to send %s %s %s %s"
|
|
|
3982 cmd0 cmd1 cmd2 cmd3))))
|
|
|
3983
|
|
|
3984 ;; TYPE command
|
|
|
3985 ((eq cmd0 'type)
|
|
|
3986 (setq cmd-string (concat "type " (symbol-name cmd1))))
|
|
|
3987
|
|
|
3988 ;; DIR command
|
|
|
3989 ;; cmd == 'dir "remote-path" "local-path" "ls-switches"
|
|
|
3990 ((memq cmd0 '(dir nlist))
|
|
|
3991 (let ((host-type (efs-host-type host user))
|
|
|
3992 (listing-type (efs-listing-type host user)))
|
|
|
3993 (setq cmd1 (efs-fix-dir-path host-type cmd1))
|
|
|
3994 (cond
|
|
|
3995 ((memq listing-type efs-nlist-listing-types)
|
|
|
3996 (setq cmd-string (concat efs-nlist-cmd " "
|
|
|
3997 (efs-quote-string host-type cmd1)
|
|
|
3998 " " cmd2)))
|
|
|
3999 ((or (memq host-type efs-dumb-host-types)
|
|
|
4000 (null cmd3))
|
|
|
4001 (setq cmd-string (format "%s %s %s"
|
|
|
4002 (if (eq cmd0 'nlist)
|
|
|
4003 efs-nlist-cmd
|
|
|
4004 "dir")
|
|
|
4005 (efs-quote-string host-type cmd1)
|
|
|
4006 cmd2)))
|
|
|
4007 ((setq cmd-string
|
|
|
4008 (format "%s \"%s %s\" %s"
|
|
|
4009 (if (eq cmd0 'nlist)
|
|
|
4010 efs-nlist-cmd
|
|
|
4011 "ls")
|
|
|
4012 cmd3 (efs-quote-string host-type cmd1 t)
|
|
|
4013 ;; cmd2 is a temp file, not nec. to quote.
|
|
|
4014 cmd2))))))
|
|
|
4015
|
|
|
4016 ;; First argument is the remote pathname
|
|
|
4017 ((memq cmd0 '(delete mkdir rmdir cd))
|
|
|
4018 (let ((host-type (efs-host-type host user)))
|
|
|
4019 (setq cmd1 (efs-quote-string host-type
|
|
|
4020 (efs-fix-path host-type cmd1))
|
|
|
4021 cmd-string (concat (symbol-name cmd0) " " cmd1))))
|
|
|
4022
|
|
|
4023 ;; GET command
|
|
|
4024 ((eq cmd0 'get)
|
|
|
4025 (let ((host-type (efs-host-type host user)))
|
|
|
4026 (if cmd3 (efs-set-xfer-type host user cmd3))
|
|
|
4027 (efs-set-hash-mark-unit host user t)
|
|
|
4028 (setq cmd1 (efs-quote-string host-type
|
|
|
4029 (efs-fix-path host-type cmd1))
|
|
|
4030 cmd2 (efs-quote-string host-type cmd2)
|
|
|
4031 cmd-string (concat "get " cmd1 " " cmd2))))
|
|
|
4032
|
|
|
4033 ;; PUT command
|
|
|
4034 ((eq cmd0 'put)
|
|
|
4035 (let ((host-type (efs-host-type host user)))
|
|
|
4036 (if (memq host-type efs-unix-host-types)
|
|
|
4037 (efs-set-umask host user))
|
|
|
4038 (if cmd3 (efs-set-xfer-type host user cmd3))
|
|
|
4039 (efs-set-hash-mark-unit host user)
|
|
|
4040 (setq cmd2 (efs-quote-string host-type
|
|
|
4041 (efs-fix-path host-type cmd2))
|
|
|
4042 cmd1 (efs-quote-string host-type cmd1)
|
|
|
4043 cmd-string (concat "put " cmd1 " " cmd2))))
|
|
|
4044
|
|
|
4045 ;; APPEND command
|
|
|
4046 ((eq cmd0 'append)
|
|
|
4047 (let ((host-type (efs-host-type 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 "append " cmd1 " " cmd2))))
|
|
|
4054
|
|
|
4055 ;; CHMOD command
|
|
|
4056 ((eq cmd0 'chmod)
|
|
|
4057 (let ((host-type (efs-host-type host user)))
|
|
|
4058 (setq cmd2 (efs-quote-string host-type
|
|
|
4059 (efs-fix-path host-type cmd2))
|
|
|
4060 cmd-string (concat "chmod " cmd1 " " cmd2))))
|
|
|
4061
|
|
|
4062 ;; Both arguments are remote pathnames
|
|
|
4063 ((eq cmd0 'rename)
|
|
|
4064 (let ((host-type (efs-host-type host user)))
|
|
|
4065 (setq cmd1 (efs-quote-string host-type
|
|
|
4066 (efs-fix-path host-type cmd1))
|
|
|
4067 cmd2 (efs-quote-string host-type
|
|
|
4068 (efs-fix-path host-type cmd2))
|
|
|
4069 cmd-string (concat "rename " cmd1 " " cmd2))))
|
|
|
4070
|
|
|
4071 (t
|
|
|
4072 (error "efs: Don't know how to send %s %s %s %s"
|
|
|
4073 cmd0 cmd1 cmd2 cmd3))))
|
|
|
4074
|
|
|
4075 ;; Actually send the resulting command.
|
|
|
4076 ;; Why do we use this complicated binding of afsc-{result,line},
|
|
|
4077 ;; rather then use the fact that efs-raw-send-cmd returns?
|
|
|
4078 ;; Because efs-raw-send-cmd returns the result of the first
|
|
|
4079 ;; attempt only. efs-send-cmd should return the result of
|
|
|
4080 ;; the retry, if one was necessary.
|
|
|
4081 ;; Maybe it would be better if efs-raw-send-cmd returned
|
|
|
4082 ;; the result of cont, if nowait was nil? Or maybe still return
|
|
|
4083 ;; \(result line \)? As long as nowait is nil, it should
|
|
|
4084 ;; return something useful.
|
|
|
4085
|
|
|
4086 ;; Beware, if some of the above FTP commands had to restart
|
|
|
4087 ;; the process, PROC won't be set to the right process object.
|
|
|
4088 (setq proc (efs-get-process host user))
|
|
|
4089
|
|
|
4090 (efs-raw-send-cmd
|
|
|
4091 proc
|
|
|
4092 cmd-string
|
|
|
4093 msg
|
|
|
4094 pre-cont
|
|
|
4095 (efs-cont (result line cont-lines) (host user proc cmd msg pre-cont
|
|
|
4096 cont nowait noretry)
|
|
|
4097 (cond ((and (null noretry) (eq result 'fatal))
|
|
|
4098 (let ((retry
|
|
|
4099 (efs-send-cmd
|
|
|
4100 host user cmd msg pre-cont cont
|
|
|
4101 (if (eq nowait t) 1 nowait) t)))
|
|
|
4102 (or cont nowait
|
|
|
4103 (setq afsc-result (car retry)
|
|
|
4104 afsc-line (nth 1 retry)
|
|
|
4105 afsc-cont-lines (nth 2 retry)))))
|
|
|
4106 ((and (eq result 'failed)
|
|
|
4107 (or (memq (car cmd) '(append rename put))
|
|
|
4108 (and (eq (car cmd) 'quote)
|
|
|
4109 (eq (nth 1 cmd) 'stor)))
|
|
|
4110 (efs-save-match-data
|
|
|
4111 (string-match efs-write-protect-msgs line)))
|
|
|
4112 (let ((retry (efs-write-recover
|
|
|
4113 (efs-host-type host)
|
|
|
4114 line cont-lines host user cmd msg pre-cont
|
|
|
4115 cont nowait noretry)))
|
|
|
4116 (or cont nowait
|
|
|
4117 (setq afsc-result (car retry)
|
|
|
4118 afsc-line (nth 1 retry)
|
|
|
4119 afsc-cont-lines (nth 2 retry)))))
|
|
|
4120
|
|
|
4121 (t (if cont
|
|
|
4122 (efs-call-cont cont result line cont-lines)
|
|
|
4123 (or nowait
|
|
|
4124 (setq afsc-result result
|
|
|
4125 afsc-line line
|
|
|
4126 afsc-cont-lines cont-lines))))))
|
|
|
4127 nowait)
|
|
|
4128
|
|
|
4129 (prog1
|
|
|
4130 (if (or nowait cont)
|
|
|
4131 nil
|
|
|
4132 (list afsc-result afsc-line afsc-cont-lines))
|
|
|
4133
|
|
|
4134 ;; Check the queue
|
|
|
4135 (or nowait
|
|
|
4136 efs-nested-cmd
|
|
|
4137 (let ((buff (efs-ftp-process-buffer host user)))
|
|
|
4138 (if (get-buffer buff)
|
|
|
4139 (save-excursion
|
|
|
4140 (set-buffer buff)
|
|
|
4141 (if efs-process-q
|
|
|
4142 (let ((next (car efs-process-q)))
|
|
|
4143 (setq efs-process-q (cdr efs-process-q))
|
|
|
4144 (apply 'efs-send-cmd host user next))))))))))))
|
|
|
4145
|
|
|
4146 (efs-defun efs-write-recover nil
|
|
|
4147 (line cont-lines host user cmd msg pre-cont cont nowait noretry)
|
|
|
4148 "Called when a write command fails with `efs-write-protect-msgs'.
|
|
|
4149 Should return \(result line cont-lines\), like `efs-raw-send-cmd'."
|
|
|
4150 ;; This default version doesn't do anything.
|
|
|
4151 (if cont
|
|
|
4152 (progn
|
|
|
4153 (efs-call-cont cont 'failed line cont-lines)
|
|
|
4154 nil)
|
|
|
4155 (if nowait nil (list 'failed line cont-lines))))
|
|
|
4156
|
|
|
4157 ;;;; ---------------------------------------------------------------------
|
|
|
4158 ;;;; The login sequence. (The follows RFC959 rather tightly. If a server
|
|
|
4159 ;;;; can't even get the login codes right, it is
|
|
|
4160 ;;;; pretty much scrap metal.)
|
|
|
4161 ;;;; ---------------------------------------------------------------------
|
|
|
4162
|
|
|
4163 (defun efs-nslookup-host (host)
|
|
|
4164 "Attempt to resolve the given HOSTNAME using nslookup if possible."
|
|
|
4165 (interactive "sHost: ")
|
|
|
4166 (if efs-nslookup-program
|
|
|
4167 (let* ((default-directory exec-directory)
|
|
|
4168 (default-major-mode 'fundamental-mode)
|
|
|
4169 (process-connection-type nil)
|
|
|
4170 (proc (start-process " *nslookup*" " *nslookup*"
|
|
|
4171 efs-nslookup-program host))
|
|
|
4172 (res host))
|
|
|
4173 (process-kill-without-query proc)
|
|
|
4174 (save-excursion
|
|
|
4175 (set-buffer (process-buffer proc))
|
|
|
4176 (let ((quit-flag nil)
|
|
|
4177 (inhibit-quit nil))
|
|
|
4178 (while (memq (process-status proc) '(run open))
|
|
|
4179 (accept-process-output proc)))
|
|
|
4180 (goto-char (point-min))
|
|
|
4181 (if (re-search-forward
|
|
|
4182 "Name:.*\nAddress\\(es\\)?: *\\([.0-9]+\\)$" nil t)
|
|
|
4183 (setq res (buffer-substring (match-beginning 2)
|
|
|
4184 (match-end 2))))
|
|
|
4185 (kill-buffer (current-buffer)))
|
|
|
4186 (if (interactive-p)
|
|
|
4187 (message "%s: %s" host res))
|
|
|
4188 res)
|
|
|
4189 (if (interactive-p)
|
|
|
4190 (message
|
|
|
4191 "No nslookup program. See the variable efs-nslookup-program."))
|
|
|
4192 host))
|
|
|
4193
|
|
|
4194 (defun efs-login (host user proc)
|
|
|
4195 "Connect to the FTP-server on HOST as USER.
|
|
|
4196 PROC is the process to the FTP-client. Doesn't call efs-save-match-data.
|
|
|
4197 You must do that yourself."
|
|
|
4198 (let ((gate (efs-use-gateway-p host)))
|
|
|
4199 (if (eq gate 'kerberos)
|
|
|
4200 (progn
|
|
|
4201 (setq proc (efs-kerberos-login host user proc))
|
|
|
4202 (efs-login-send-user host user proc gate))
|
|
|
4203 (let ((to (if (memq gate '(proxy local raptor))
|
|
|
4204 efs-gateway-host
|
|
|
4205 host))
|
|
|
4206 port cmd result)
|
|
|
4207 (if (string-match "#" to)
|
|
|
4208 (setq port (substring to (match-end 0))
|
|
|
4209 to (substring to 0 (match-beginning 0))))
|
|
|
4210 (and efs-nslookup-on-connect
|
|
|
4211 (string-match "[^0-9.]" to)
|
|
|
4212 (setq to (efs-nslookup-host to)))
|
|
|
4213 (setq cmd (concat "open " to))
|
|
|
4214 (if port (setq cmd (concat cmd " " port)))
|
|
|
4215
|
|
|
4216 ;; Send OPEN command.
|
|
|
4217 (setq result (efs-raw-send-cmd proc cmd nil))
|
|
|
4218
|
|
|
4219 (and (eq gate 'interlock) (string-match "^331 " (nth 1 result))
|
|
|
4220 (setq result (efs-login-send-pass
|
|
|
4221 efs-gateway-host
|
|
|
4222 (efs-get-user efs-gateway-host) proc)))
|
|
|
4223
|
|
|
4224 ;; Analyze result of OPEN.
|
|
|
4225 (if (car result)
|
|
|
4226 (progn
|
|
|
4227 (condition-case nil (delete-process proc) (error nil))
|
|
|
4228 (efs-error host user (concat "OPEN request failed: "
|
|
|
4229 (nth 1 result))))
|
|
|
4230 (efs-login-send-user host user proc gate))))))
|
|
|
4231
|
|
|
4232 (defun efs-login-send-user (host user proc &optional gate retry)
|
|
|
4233 "Send user command to HOST and USER. PROC is the ftp client process.
|
|
|
4234 Optional argument GATE specifies which type of gateway is being used.
|
|
|
4235 RETRY argument specifies to try twice if we get a 421 response."
|
|
|
4236 (let ((cmd (cond
|
|
|
4237 ((memq gate '(local proxy interlock))
|
|
|
4238 (format "quote USER \"%s\"@%s" user
|
|
|
4239 (if (and efs-nslookup-on-connect
|
|
|
4240 (string-match "[^0-9.]" host))
|
|
|
4241 (efs-nslookup-host host)
|
|
|
4242 host)))
|
|
|
4243 ((eq gate 'raptor)
|
|
|
4244 (format "quote USER \"%s\"@%s %s" user
|
|
|
4245 (if (and efs-nslookup-on-connect
|
|
|
4246 (string-match "[^0-9.]" host))
|
|
|
4247 (efs-nslookup-host host)
|
|
|
4248 host)
|
|
|
4249 (nth 3 efs-gateway-type)))
|
|
|
4250 ((eq gate 'kerberos)
|
|
|
4251 (let ((to host)
|
|
|
4252 port)
|
|
|
4253 (if (string-match "#" host)
|
|
|
4254 (progn
|
|
|
4255 (setq to (substring host 0 (match-beginning 0))
|
|
|
4256 port (substring host (match-end 0)))
|
|
|
4257 (and efs-nslookup-on-connect
|
|
|
4258 (string-match "[^0-9.]" to)
|
|
|
4259 (efs-nslookup-host to))
|
|
|
4260 (setq to (concat to "@" port))))
|
|
|
4261 (format "quote user \"%s\"@%s" user to)))
|
|
|
4262 (t
|
|
|
4263 (format "quote user \"%s\"" user))))
|
|
|
4264 (msg (format "Logging in as user %s%s..." user
|
|
|
4265 (if (memq gate '(proxy local raptor kerberos))
|
|
|
4266 (concat "@" host) "")))
|
|
|
4267 result code)
|
|
|
4268
|
|
|
4269 ;; Send the message by hand so that we can report on the size
|
|
|
4270 ;; of the MOTD.
|
|
|
4271 (message msg)
|
|
|
4272
|
|
|
4273 ;; Send USER command.
|
|
|
4274 (setq result (efs-raw-send-cmd proc cmd nil))
|
|
|
4275
|
|
|
4276 ;; Analyze result of USER (this follows RFC959 strictly)
|
|
|
4277 (if (< (length (nth 1 result)) 4)
|
|
|
4278 (progn
|
|
|
4279 (condition-case nil (delete-process proc) (error nil))
|
|
|
4280 (efs-error host user
|
|
|
4281 (concat "USER request failed: " (nth 1 result))))
|
|
|
4282
|
|
|
4283 (setq code (substring (nth 1 result) 0 4))
|
|
|
4284 (cond
|
|
|
4285
|
|
|
4286 ((string-equal "331 " code)
|
|
|
4287 ;; Need password
|
|
|
4288 (setq result (efs-login-send-pass host user proc gate)))
|
|
|
4289
|
|
|
4290 ((string-equal "332 " code)
|
|
|
4291 ;; Need an account, but no password
|
|
|
4292 (setq result (efs-login-send-acct host user proc gate)))
|
|
|
4293
|
|
|
4294 ((null (car result))
|
|
|
4295 ;; logged in proceed
|
|
|
4296 nil)
|
|
|
4297
|
|
|
4298 ((and (or (string-equal "530 " code) (string-equal "421 " code))
|
|
|
4299 (efs-anonymous-p user)
|
|
|
4300 (or (string-match efs-too-many-users-msgs (nth 1 result))
|
|
|
4301 (string-match efs-too-many-users-msgs (nth 2 result))))
|
|
|
4302 (if (save-window-excursion
|
|
|
4303 (condition-case nil
|
|
|
4304 (display-buffer (process-buffer proc))
|
|
|
4305 (error nil))
|
|
|
4306 (y-or-n-p (format
|
|
|
4307 "Too many users for %s@%s. Try again? "
|
|
|
4308 user host)))
|
|
|
4309 (progn
|
|
|
4310 ;; Set result to nil if we are doing a retry, so done
|
|
|
4311 ;; message only gets sent once.
|
|
|
4312 (setq result nil)
|
|
|
4313 (if (string-equal code "530 ")
|
|
|
4314 (efs-login-send-user host user proc gate t)
|
|
|
4315 (efs-get-process host user)))
|
|
|
4316 (signal 'quit nil)))
|
|
|
4317
|
|
|
4318 ((and retry (string-equal code "421 "))
|
|
|
4319 (setq result nil)
|
|
|
4320 (efs-get-process host user))
|
|
|
4321
|
|
|
4322 (t ; bombed
|
|
|
4323 (condition-case nil (delete-process proc) (error nil))
|
|
|
4324 ;; Wrong username?
|
|
|
4325 (efs-set-user host nil)
|
|
|
4326 (efs-error host user
|
|
|
4327 (concat "USER request failed: " (nth 1 result)))))
|
|
|
4328 (and (null (car result))
|
|
|
4329 (stringp (nth 2 result))
|
|
|
4330 (message "%sdone%s" msg
|
|
|
4331 (let ((n (efs-occur-in-string ?\n (nth 2 result))))
|
|
|
4332 (if (> n 1)
|
|
|
4333 (format "; MOTD of %d lines" n)
|
|
|
4334 "")))))))
|
|
|
4335
|
|
|
4336 (defun efs-login-send-pass (host user proc &optional gate)
|
|
|
4337 "Sends password to HOST and USER. PROC is the ftp client process.
|
|
|
4338 Doesn't call efs-save-match data. You must do that yourself."
|
|
|
4339 ;; Note that efs-get-password always returns something.
|
|
|
4340 ;; It prompts the user if necessary. Even if the returned password is
|
|
|
4341 ;; \"\", send it, because we wouldn't be running this function
|
|
|
4342 ;; if the server wasn't insisting on a password.
|
|
|
4343 (let* ((pass "")
|
|
|
4344 (qpass "")
|
|
|
4345 (cmd "")
|
|
|
4346 (result (unwind-protect
|
|
|
4347 (progn
|
|
|
4348 (condition-case nil
|
|
|
4349 (setq pass (efs-get-passwd host user))
|
|
|
4350 (quit (condition-case nil
|
|
|
4351 (kill-buffer (process-buffer proc))
|
|
|
4352 (error nil))
|
|
|
4353 (signal 'quit nil)))
|
|
|
4354 (setq cmd (concat
|
|
|
4355 "quote pass "
|
|
|
4356 (setq qpass (efs-quote-string nil pass t))))
|
|
|
4357 (efs-raw-send-cmd proc cmd))
|
|
|
4358 (fillarray pass 0)
|
|
|
4359 (fillarray qpass 0)
|
|
|
4360 (fillarray cmd 0)))
|
|
|
4361 (code (and (>= (length (nth 1 result)) 4)
|
|
|
4362 (substring (nth 1 result) 0 4))))
|
|
|
4363 (or code (setq code ""))
|
|
|
4364 ;; Analyze the result.
|
|
|
4365 (cond
|
|
|
4366 ((string-equal code "332 ")
|
|
|
4367 ;; require an account passwd
|
|
|
4368 (setq result (efs-login-send-acct host user proc gate)))
|
|
|
4369 ((null (car result))
|
|
|
4370 ;; logged in proceed
|
|
|
4371 nil)
|
|
|
4372 ((or (string-equal code "530 ") (string-equal code "421 "))
|
|
|
4373 ;; Give the user another chance
|
|
|
4374 (condition-case nil
|
|
|
4375 (if (efs-anonymous-p user)
|
|
|
4376 (if (or (string-match efs-too-many-users-msgs (nth 1 result))
|
|
|
4377 (string-match efs-too-many-users-msgs (nth 2 result)))
|
|
|
4378 (if (save-window-excursion
|
|
|
4379 (condition-case nil
|
|
|
4380 (display-buffer (process-buffer proc))
|
|
|
4381 (error nil))
|
|
|
4382 (y-or-n-p (format
|
|
|
4383 "Too many users for %s@%s. Try again? "
|
|
|
4384 user host)))
|
|
|
4385 (progn
|
|
|
4386 ;; Return nil if we are doing a retry, so done
|
|
|
4387 ;; message only gets sent once.
|
|
|
4388 (setq result nil)
|
|
|
4389 (if (string-equal code "530 ")
|
|
|
4390 (efs-login-send-user host user proc gate)
|
|
|
4391 (efs-get-process host user)))
|
|
|
4392 (signal 'quit nil))
|
|
|
4393 (unwind-protect
|
|
|
4394 (efs-set-passwd
|
|
|
4395 host user
|
|
|
4396 (save-window-excursion
|
|
|
4397 (condition-case nil
|
|
|
4398 (display-buffer (process-buffer proc))
|
|
|
4399 (error nil))
|
|
|
4400 (setq pass
|
|
|
4401 (read-passwd
|
|
|
4402 (format
|
|
|
4403 "Password for %s@%s failed. Try again: "
|
|
|
4404 user host)))))
|
|
|
4405 (fillarray pass 0))
|
|
|
4406 (setq result nil)
|
|
|
4407 (efs-login-send-user host user proc gate))
|
|
|
4408 (unwind-protect
|
|
|
4409 (efs-set-passwd
|
|
|
4410 host user
|
|
|
4411 (setq pass
|
|
|
4412 (read-passwd
|
|
|
4413 (format "Password for %s@%s failed. Try again: "
|
|
|
4414 user host))))
|
|
|
4415 (fillarray pass 0))
|
|
|
4416 (setq result nil)
|
|
|
4417 (efs-login-send-user host user proc gate))
|
|
|
4418 (quit (condition-case nil (delete-process proc) (error nil))
|
|
|
4419 (efs-set-user host nil)
|
|
|
4420 (efs-set-passwd host user nil)
|
|
|
4421 (signal 'quit nil))
|
|
|
4422 (error (condition-case nil (delete-process proc) (error nil))
|
|
|
4423 (efs-set-user host nil)
|
|
|
4424 (efs-set-passwd host user nil)
|
|
|
4425 (efs-error host user "PASS request failed."))))
|
|
|
4426 (t ; bombed for unexplained reasons
|
|
|
4427 (condition-case nil (delete-process proc) (error nil))
|
|
|
4428 (efs-error host user (concat "PASS request failed: " (nth 1 result)))))
|
|
|
4429 result))
|
|
|
4430
|
|
|
4431 (defun efs-login-send-acct (host user proc &optional gate)
|
|
|
4432 "Sends account password to HOST and USER. PROC is the ftp client process.
|
|
|
4433 Doesn't call efs-save-match data. You must do that yourself."
|
|
|
4434 (let* ((acct "")
|
|
|
4435 (qacct "")
|
|
|
4436 (cmd "")
|
|
|
4437 (result (unwind-protect
|
|
|
4438 (progn
|
|
|
4439 ;; The raptor gateway requires us to send a gateway
|
|
|
4440 ;; authentication password for account. What if the
|
|
|
4441 ;; remote server wants one too?
|
|
|
4442 (setq acct (if (eq gate 'raptor)
|
|
|
4443 (efs-get-account
|
|
|
4444 efs-gateway-host
|
|
|
4445 (nth 3 efs-gateway-type) nil t)
|
|
|
4446 (efs-get-account host user nil t))
|
|
|
4447 qacct (efs-quote-string nil acct t)
|
|
|
4448 cmd (concat "quote acct " qacct))
|
|
|
4449 (efs-raw-send-cmd proc cmd))
|
|
|
4450 (fillarray acct 0)
|
|
|
4451 (fillarray qacct 0)
|
|
|
4452 (fillarray cmd 0))))
|
|
|
4453 ;; Analyze the result
|
|
|
4454 (cond
|
|
|
4455 ((null (car result))
|
|
|
4456 ;; logged in proceed
|
|
|
4457 nil)
|
|
|
4458 ((eq (car result) 'failed)
|
|
|
4459 ;; Give the user another chance
|
|
|
4460 (condition-case nil
|
|
|
4461 (progn
|
|
|
4462 (unwind-protect
|
|
|
4463 (progn
|
|
|
4464 (setq acct (read-passwd
|
|
|
4465 (format
|
|
|
4466 "Account password for %s@%s failed. Try again: "
|
|
|
4467 user host)))
|
|
|
4468 (or (and efs-high-security-hosts
|
|
|
4469 (string-match efs-high-security-hosts
|
|
|
4470 (format "%s@%s" user host)))
|
|
|
4471 (efs-set-account host user nil acct)))
|
|
|
4472 (fillarray acct 0))
|
|
|
4473 (setq result (efs-login-send-user host user proc gate)))
|
|
|
4474 (quit (condition-case nil (delete-process proc) (error nil)))
|
|
|
4475 (error (condition-case nil (delete-process proc) (error nil))
|
|
|
4476 (efs-error host user "ACCT request failed."))))
|
|
|
4477 (t ; bombed for unexplained reasons
|
|
|
4478 (condition-case nil (delete-process proc) (error nil))
|
|
|
4479 (efs-error host user (concat "ACCT request failed: " (nth 1 result)))))
|
|
|
4480 result))
|
|
|
4481
|
|
|
4482 ;;;; ----------------------------------------------------------------------
|
|
|
4483 ;;;; Changing working directory.
|
|
|
4484 ;;;; ----------------------------------------------------------------------
|
|
|
4485
|
|
|
4486 (defun efs-raw-send-cd (host user dir &optional no-error)
|
|
|
4487 ;; If NO-ERROR, doesn't barf, but just returns success (t) or failure (nil).
|
|
|
4488 ;; This does not use efs-send-cmd.
|
|
|
4489 ;; Also DIR must be in the syntax of the remote host-type.
|
|
|
4490 (let* ((cmd (concat "cd " dir))
|
|
|
4491 cd-result cd-line)
|
|
|
4492 (efs-raw-send-cmd
|
|
|
4493 (efs-get-process host user)
|
|
|
4494 cmd nil nil
|
|
|
4495 (efs-cont (result line cont-lines) (cmd)
|
|
|
4496 (if (eq result 'fatal)
|
|
|
4497 (efs-raw-send-cmd
|
|
|
4498 (efs-get-process host user)
|
|
|
4499 cmd nil nil
|
|
|
4500 (function (lambda (result line cont-lines)
|
|
|
4501 (setq cd-result result
|
|
|
4502 cd-line line))))
|
|
|
4503 (setq cd-result result
|
|
|
4504 cd-line line))))
|
|
|
4505 (if no-error
|
|
|
4506 (null cd-result)
|
|
|
4507 (if cd-result
|
|
|
4508 (efs-error host user (concat "CD failed: " cd-line))))))
|
|
|
4509
|
|
|
4510 ;;;; --------------------------------------------------------------
|
|
|
4511 ;;;; Getting a PWD.
|
|
|
4512 ;;;; --------------------------------------------------------------
|
|
|
4513
|
|
|
4514 (defun efs-unquote-quotes (string)
|
|
|
4515 ;; Unquote \"\"'s in STRING to \".
|
|
|
4516 (let ((start 0)
|
|
|
4517 new)
|
|
|
4518 (while (string-match "\"\"" string start)
|
|
|
4519 (setq new (concat new (substring
|
|
|
4520 string start (1+ (match-beginning 0))))
|
|
|
4521 start (match-end 0)))
|
|
|
4522 (if new
|
|
|
4523 (concat new (substring string start))
|
|
|
4524 string)))
|
|
|
4525
|
|
|
4526 (efs-defun efs-send-pwd nil (host user &optional xpwd)
|
|
|
4527 "Attempts to get the current working directory for the given HOST/USER pair.
|
|
|
4528 Returns \( DIR . LINE \) where DIR is either the directory or NIL if not found,
|
|
|
4529 and LINE is the relevant success or fail line from the FTP-server. If the
|
|
|
4530 optional arg XPWD is given, uses this server command instead of PWD."
|
|
|
4531 (let* ((result (efs-send-cmd host user
|
|
|
4532 (list 'quote (if xpwd 'xpwd 'pwd))
|
|
|
4533 "Getting pwd"))
|
|
|
4534 (line (nth 1 result))
|
|
|
4535 dir)
|
|
|
4536 (or (car result)
|
|
|
4537 (efs-save-match-data
|
|
|
4538 (if (string-match "\"\\(.*\\)\"[^\"]*$" line)
|
|
|
4539 (setq dir (efs-unquote-quotes (substring line (match-beginning 1)
|
|
|
4540 (match-end 1))))
|
|
|
4541 (if (string-match " \\([^ ]+\\) " line) ; stone-age servers!
|
|
|
4542 (setq dir (substring line
|
|
|
4543 (match-beginning 1)
|
|
|
4544 (match-end 1)))))))
|
|
|
4545 (cons dir line)))
|
|
|
4546
|
|
|
4547 (efs-defun efs-send-pwd super-dumb-unix (host user &optional xpwd)
|
|
|
4548 ;; Guess at the pwd for a unix host that doesn't support pwd.
|
|
|
4549 (if (efs-anonymous-p user)
|
|
|
4550 ;; guess
|
|
|
4551 (cons "/" "")
|
|
|
4552 ;; Who knows?
|
|
|
4553 (message "Can't obtain pwd for %s" host)
|
|
|
4554 (ding)
|
|
|
4555 (sleep-for 2)
|
|
|
4556 (message "All file names must be specified as full paths.")
|
|
|
4557 (cons nil "")))
|
|
|
4558
|
|
|
4559 ;;;; --------------------------------------------------------
|
|
|
4560 ;;;; Getting the SIZE of a remote file.
|
|
|
4561 ;;;; --------------------------------------------------------
|
|
|
4562
|
|
|
4563 (defun efs-send-size (host user file)
|
|
|
4564 "For HOST and USER, get the size of FILE in bytes.
|
|
|
4565 This returns a list \( SIZE . LINE \), where SIZE is the file size in bytes,
|
|
|
4566 or nil if this couldn't be determined, and LINE is the output line of the
|
|
|
4567 FTP server."
|
|
|
4568 (efs-save-match-data
|
|
|
4569 (let ((result (efs-send-cmd host user (list 'quote 'size file))))
|
|
|
4570 (setcar result
|
|
|
4571 (and (null (car result))
|
|
|
4572 (string-match "^213 +\\([0-9]+\\)$" (nth 1 result))
|
|
|
4573 (string-to-int
|
|
|
4574 (substring
|
|
|
4575 (cdr result)
|
|
|
4576 (match-beginning 1) (match-end 1)))))
|
|
|
4577 result)))
|
|
|
4578
|
|
|
4579 ;;;; ------------------------------------------------------------
|
|
|
4580 ;;;; umask support
|
|
|
4581 ;;;; ------------------------------------------------------------
|
|
|
4582
|
|
|
4583 (defun efs-umask (user)
|
|
|
4584 "Returns the umask that efs will use for USER.
|
|
|
4585 If USER is root or anonymous, then the values of efs-root-umask
|
|
|
4586 and efs-anonymous-umask, respectively, take precedence, to be followed
|
|
|
4587 by the value of efs-umask, and if this is nil, it returns your current
|
|
|
4588 umask on the local machine. Returns nil if this can't be determined."
|
|
|
4589 (or
|
|
|
4590 (and (string-equal user "root") efs-root-umask)
|
|
|
4591 (and (efs-anonymous-p user)
|
|
|
4592 efs-anonymous-umask)
|
|
|
4593 efs-umask
|
|
|
4594 (let* ((shell (or (and (boundp 'explicit-shell-file-name)
|
|
|
4595 explicit-shell-file-name)
|
|
|
4596 (getenv "ESHELL")
|
|
|
4597 (getenv "SHELL")
|
|
|
4598 "/bin/sh"))
|
|
|
4599 (default-major-mode 'fundamental-mode)
|
|
|
4600 (default-directory exec-directory)
|
|
|
4601 (buff (get-buffer-create " *efs-umask-data*")))
|
|
|
4602 (unwind-protect
|
|
|
4603 (save-excursion
|
|
|
4604 (set-buffer buff)
|
|
|
4605 (call-process shell nil buff nil "-c" "umask")
|
|
|
4606 (goto-char (point-min))
|
|
|
4607 (if (re-search-forward "[0-7]?[0-7]?[0-7]" nil t)
|
|
|
4608 (string-to-int (buffer-substring (match-beginning 0)
|
|
|
4609 (match-end 0)))))
|
|
|
4610 (kill-buffer buff)))))
|
|
|
4611
|
|
|
4612 (defun efs-send-umask (host user mask)
|
|
|
4613 "Sets the umask on HOST for USER to MASK.
|
|
|
4614 Returns t for success, nil for failure."
|
|
|
4615 (interactive
|
|
|
4616 (let* ((path (or buffer-file-name
|
|
|
4617 (and (eq major-mode 'dired-mode)
|
|
|
4618 dired-directory)))
|
|
|
4619 (parsed (and path (efs-ftp-path path)))
|
|
|
4620 (default-host (car parsed))
|
|
|
4621 (default-user (nth 1 parsed))
|
|
|
4622 (default-mask (efs-umask default-user)))
|
|
|
4623 (list
|
|
|
4624 (read-string "Host: " default-host)
|
|
|
4625 (read-string "User: " default-user)
|
|
|
4626 (read-string "Umask: " (int-to-string default-mask)))))
|
|
|
4627 (let (int-mask)
|
|
|
4628 (if (integerp mask)
|
|
|
4629 (setq int-mask mask
|
|
|
4630 mask (int-to-string mask))
|
|
|
4631 (setq int-mask (string-to-int mask)))
|
|
|
4632 (or (string-match "^ *[0-7]?[0-7]?[0-7] *$" mask)
|
|
|
4633 (error "Invalid umask %s" mask))
|
|
|
4634 (efs-send-cmd host user
|
|
|
4635 (list 'quote 'site 'umask mask)
|
|
|
4636 (concat "Setting umask to " mask)
|
|
|
4637 (list
|
|
|
4638 (function
|
|
|
4639 (lambda (int-mask)
|
|
|
4640 (let ((buff (efs-ftp-process-buffer host user)))
|
|
|
4641 (if (get-buffer buff)
|
|
|
4642 (save-excursion
|
|
|
4643 (set-buffer buff)
|
|
|
4644 (setq efs-process-umask int-mask))))))
|
|
|
4645 int-mask)
|
|
|
4646 (efs-cont (result line cont-lines) (host user mask)
|
|
|
4647 (if result
|
|
|
4648 (let ((buff (efs-ftp-process-buffer host user)))
|
|
|
4649 (efs-set-host-property host 'umask-failed t)
|
|
|
4650 (if (get-buffer buff)
|
|
|
4651 (save-excursion
|
|
|
4652 (set-buffer buff)
|
|
|
4653 (setq efs-process-umask nil)))
|
|
|
4654 (message
|
|
|
4655 "Unable to set umask to %s on %s" mask host)
|
|
|
4656 (if efs-ding-on-umask-failure
|
|
|
4657 (progn
|
|
|
4658 (ding)
|
|
|
4659 (sit-for 1))))))
|
|
|
4660 0))) ; Do this NOWAIT = 0
|
|
|
4661
|
|
|
4662 (defun efs-set-umask (host user)
|
|
|
4663 "Sets the umask for HOST and USER, if it has not already been set."
|
|
|
4664 (save-excursion
|
|
|
4665 (set-buffer (process-buffer (efs-get-process host user)))
|
|
|
4666 (if (or efs-process-umask (efs-get-host-property host 'umask-failed))
|
|
|
4667 nil
|
|
|
4668 (let ((umask (efs-umask user)))
|
|
|
4669 (efs-send-umask host user umask)
|
|
|
4670 t)))) ; Tell the caller that we did something.
|
|
|
4671
|
|
|
4672 (defun efs-modes-from-umask (umask)
|
|
|
4673 ;; Given the 3 digit octal integer umask, returns the decimal integer
|
|
|
4674 ;; according to chmod that a file would be written with.
|
|
|
4675 ;; Assumes only ordinary files, so ignores x bits.
|
|
|
4676 (let* ((others (% umask 10))
|
|
|
4677 (umask (/ umask 10))
|
|
|
4678 (group (% umask 10))
|
|
|
4679 (umask (/ umask 10))
|
|
|
4680 (owner (% umask 10))
|
|
|
4681 (factor 1))
|
|
|
4682 (apply '+
|
|
|
4683 (mapcar
|
|
|
4684 (function
|
|
|
4685 (lambda (x)
|
|
|
4686 (prog1
|
|
|
4687 (* factor (- 6 (- x (% x 2))))
|
|
|
4688 (setq factor (* factor 8)))))
|
|
|
4689 (list others group owner)))))
|
|
|
4690
|
|
|
4691 ;;;; ------------------------------------------------------------
|
|
|
4692 ;;;; Idle time manipulation.
|
|
|
4693 ;;;; ------------------------------------------------------------
|
|
|
4694
|
|
|
4695 (defun efs-check-idle (host user)
|
|
|
4696 ;; We just toss it in the queue to run whenever there's time.
|
|
|
4697 ;; Just fail quietly if this doesn't work.
|
|
|
4698 (if (and (or efs-maximize-idle efs-expire-ftp-buffers)
|
|
|
4699 (memq (efs-host-type host) efs-idle-host-types)
|
|
|
4700 (null (efs-get-host-property host 'idle-failed)))
|
|
|
4701 (let ((buffname (efs-ftp-process-buffer host user)))
|
|
|
4702 (efs-add-to-queue
|
|
|
4703 host user
|
|
|
4704 (list '(quote site idle)
|
|
|
4705 nil nil
|
|
|
4706 (efs-cont (result line cont-lines) (host user buffname)
|
|
|
4707 (efs-save-match-data
|
|
|
4708 (if (and (null result)
|
|
|
4709 (string-match efs-idle-msgs line))
|
|
|
4710 (let ((max (substring line (match-beginning 2)
|
|
|
4711 (match-end 2))))
|
|
|
4712 (if (get-buffer buffname)
|
|
|
4713 (save-excursion
|
|
|
4714 (set-buffer buffname)
|
|
|
4715 (setq efs-process-idle-time
|
|
|
4716 (string-to-int
|
|
|
4717 (substring line (match-beginning 1)
|
|
|
4718 (match-end 1))))))
|
|
|
4719 (if (and efs-maximize-idle
|
|
|
4720 (not (efs-anonymous-p user)))
|
|
|
4721 (efs-add-to-queue
|
|
|
4722 host user
|
|
|
4723 (list
|
|
|
4724 (list 'quote 'site 'idle max)
|
|
|
4725 nil nil
|
|
|
4726 (efs-cont (result line cont-lines) (buffname
|
|
|
4727 max)
|
|
|
4728 (and (null result)
|
|
|
4729 (get-buffer buffname)
|
|
|
4730 (save-excursion
|
|
|
4731 (set-buffer buffname)
|
|
|
4732 (setq efs-process-idle-time
|
|
|
4733 (string-to-int max)))))
|
|
|
4734 0))))
|
|
|
4735 (efs-set-host-property host 'idle-failed t))))
|
|
|
4736 0 nil))))) ; Using NOWAIT = 0 inhibits mode line toggling.
|
|
|
4737
|
|
|
4738
|
|
|
4739 ;;;; ------------------------------------------------------------
|
|
|
4740 ;;;; Sending the SYST command for system type.
|
|
|
4741 ;;;; ------------------------------------------------------------
|
|
|
4742
|
|
|
4743 (defun efs-get-syst (host user)
|
|
|
4744 "Use SYST to get the remote system type.
|
|
|
4745 Returns the system type as a string if this succeeds, otherwise nil."
|
|
|
4746 (let* ((result (efs-send-cmd host user '(quote syst)))
|
|
|
4747 (line (nth 1 result)))
|
|
|
4748 (efs-save-match-data
|
|
|
4749 (and (null (car result))
|
|
|
4750 (string-match efs-syst-msgs line)
|
|
|
4751 (substring line (match-end 0))))))
|
|
|
4752
|
|
|
4753 ;;;; ------------------------------------------------------------
|
|
|
4754 ;;;; File transfer representation type support
|
|
|
4755 ;;;; ------------------------------------------------------------
|
|
|
4756
|
|
|
4757 ;;; Legal representation types are: image, ascii, ebcdic, tenex
|
|
|
4758
|
|
|
4759 (efs-defun efs-file-type nil (path)
|
|
|
4760 ;; Returns the file type for PATH, the full efs path, with filename FILE.
|
|
|
4761 ;; The return value is one of 'text, '8-binary, or '36-binary.
|
|
|
4762 (let ((parsed (efs-ftp-path path)))
|
|
|
4763 (efs-save-match-data
|
|
|
4764 (cond
|
|
|
4765 ;; There is no special significance to temp names, but we assume that
|
|
|
4766 ;; they exist on an 8-bit byte machine.
|
|
|
4767 ((or (null path)
|
|
|
4768 (let ((temp (intern-soft path efs-tmp-name-obarray)))
|
|
|
4769 (and temp (memq temp efs-tmp-name-files))))
|
|
|
4770 '8-binary)
|
|
|
4771 ((and (null parsed) (file-exists-p path))
|
|
|
4772 (efs-local-file-type path))
|
|
|
4773 ;; test special hosts
|
|
|
4774 ((and parsed
|
|
|
4775 efs-binary-file-host-regexp
|
|
|
4776 (let ((case-fold-search t))
|
|
|
4777 (string-match efs-binary-file-host-regexp (car parsed))))
|
|
|
4778 '8-binary)
|
|
|
4779 (t
|
|
|
4780 ;; Test file names
|
|
|
4781 (let ((file (efs-internal-file-name-nondirectory
|
|
|
4782 (or (nth 2 parsed) path))))
|
|
|
4783 (cond
|
|
|
4784 ;; test for PDP-10 binaries
|
|
|
4785 ((and efs-36-bit-binary-file-name-regexp
|
|
|
4786 (string-match efs-36-bit-binary-file-name-regexp file))
|
|
|
4787 '36-binary)
|
|
|
4788 ((and efs-binary-file-name-regexp
|
|
|
4789 (string-match efs-binary-file-name-regexp file))
|
|
|
4790 '8-binary)
|
|
|
4791 ((and efs-text-file-name-regexp
|
|
|
4792 (string-match efs-text-file-name-regexp file))
|
|
|
4793 'text)
|
|
|
4794 ;; by default
|
|
|
4795 (t
|
|
|
4796 '8-binary))))))))
|
|
|
4797
|
|
|
4798 (efs-define-fun efs-local-file-type (file)
|
|
|
4799 ;; Looks at the beginning (magic-cookie) of a local file to determine
|
|
|
4800 ;; if it is a text file or not. If it's not a text file, it doesn't care
|
|
|
4801 ;; about what type of binary file, so this doesn't really look for a magic
|
|
|
4802 ;; cookie.
|
|
|
4803 ;; Doesn't call efs-save-match-data. The caller should do so.
|
|
|
4804 (save-excursion
|
|
|
4805 (set-buffer (get-buffer-create efs-data-buffer-name))
|
|
|
4806 (erase-buffer)
|
|
|
4807 (insert-file-contents file nil 0 16)
|
|
|
4808 (if (looking-at "[ -~\n\r\C-L]*\\'")
|
|
|
4809 'text
|
|
|
4810 '8-binary)))
|
|
|
4811
|
|
|
4812 (defun efs-rationalize-file-type (f-type t-type)
|
|
|
4813 ;; When the original and new names for a file indicate
|
|
|
4814 ;; different file types, this function applies an ad hoc heuristic
|
|
|
4815 ;; to return a single file type.
|
|
|
4816 (cond
|
|
|
4817 ((eq f-type t-type)
|
|
|
4818 f-type)
|
|
|
4819 ((memq '36-binary (list f-type t-type))
|
|
|
4820 '36-binary)
|
|
|
4821 ((memq '8-binary (list f-type t-type))
|
|
|
4822 '8-binary)
|
|
|
4823 (t
|
|
|
4824 'text)))
|
|
|
4825
|
|
|
4826 (defun efs-prompt-for-transfer-type (arg)
|
|
|
4827 "Toggles value of efs-prompt-for-transfer-type.
|
|
|
4828 With prefix arg, turns prompting on if arg is positive, otherwise turns
|
|
|
4829 prompting off."
|
|
|
4830 (interactive "P")
|
|
|
4831 (if (if arg
|
|
|
4832 (> (prefix-numeric-value arg) 0)
|
|
|
4833 (null efs-prompt-for-transfer-type))
|
|
|
4834 ;; turn prompting on
|
|
|
4835 (prog1
|
|
|
4836 (setq efs-prompt-for-transfer-type t)
|
|
|
4837 (message "Prompting for FTP transfer TYPE is on."))
|
|
|
4838 (prog1
|
|
|
4839 (setq efs-prompt-for-transfer-type nil)
|
|
|
4840 (message "Prompting for FTP transfer TYPE is off."))))
|
|
|
4841
|
|
|
4842 (defun efs-read-xfer-type (path)
|
|
|
4843 ;; Prompt for the transfer type to use for PATH
|
|
|
4844 (let ((type
|
|
|
4845 (completing-read
|
|
|
4846 (format "FTP transfer TYPE for %s: " (efs-relativize-filename path))
|
|
|
4847 '(("binary") ("image") ("ascii") ("ebcdic") ("tenex"))
|
|
|
4848 nil t)))
|
|
|
4849 (if (string-equal type "binary")
|
|
|
4850 'image
|
|
|
4851 (intern type))))
|
|
|
4852
|
|
|
4853 (defun efs-xfer-type (f-host-type f-path t-host-type t-path
|
|
|
4854 &optional via-local)
|
|
|
4855 ;; Returns the transfer type for transferring a file.
|
|
|
4856 ;; F-HOST-TYPE = the host type of the machine on which the file is from.
|
|
|
4857 ;; F-PATH = path, in full efs-syntax, of the original file
|
|
|
4858 ;; T-HOST-TYPE = host-type of the machine to which the file is being
|
|
|
4859 ;; transferred.
|
|
|
4860 ;; VIA-LOCAL = non-nil of the file is being moved through the local, or
|
|
|
4861 ;; a gateway machine.
|
|
|
4862 ;; Set F-PATH or T-PATH to nil, to indicate that the file is being
|
|
|
4863 ;; transferred from/to a temporary file, whose name has no significance.
|
|
|
4864 (let (temp)
|
|
|
4865 (and f-path
|
|
|
4866 (setq temp (intern-soft f-path efs-tmp-name-obarray))
|
|
|
4867 (memq temp efs-tmp-name-files)
|
|
|
4868 (setq f-path nil))
|
|
|
4869 (and t-path
|
|
|
4870 (setq temp (intern-soft t-path efs-tmp-name-obarray))
|
|
|
4871 (memq temp efs-tmp-name-files)
|
|
|
4872 (setq t-path nil)))
|
|
|
4873 (if (or (null (or f-host-type t-host-type)) (null (or f-path t-path)))
|
|
|
4874 'image ; local copy?
|
|
|
4875 (if efs-prompt-for-transfer-type
|
|
|
4876 (efs-read-xfer-type (if f-path f-path t-path))
|
|
|
4877 (let ((f-fs (cdr (assq f-host-type efs-file-type-alist)))
|
|
|
4878 (t-fs (cdr (assq t-host-type efs-file-type-alist))))
|
|
|
4879 (if (and f-fs t-fs
|
|
|
4880 (if efs-treat-crlf-as-nl
|
|
|
4881 (and (eq (car f-fs) (car t-fs))
|
|
|
4882 (eq (nth 1 f-fs) (nth 1 t-fs))
|
|
|
4883 (let ((f2-fs (nth 2 f-fs))
|
|
|
4884 (t2-fs (nth 2 t-fs)))
|
|
|
4885 (or (eq f2-fs t2-fs)
|
|
|
4886 (and (memq f2-fs '(file-crlf file-nl))
|
|
|
4887 (memq t2-fs '(file-crlf file-nl))))))
|
|
|
4888 (equal f-fs t-fs)))
|
|
|
4889 'image
|
|
|
4890 (let ((type (cond
|
|
|
4891 ((and f-path t-path)
|
|
|
4892 (efs-rationalize-file-type
|
|
|
4893 (efs-file-type t-host-type t-path)
|
|
|
4894 (efs-file-type f-host-type f-path)))
|
|
|
4895 (f-path
|
|
|
4896 (efs-file-type f-host-type f-path))
|
|
|
4897 (t-path
|
|
|
4898 (efs-file-type t-host-type t-path)))))
|
|
|
4899 (cond
|
|
|
4900 ((eq type '36-binary)
|
|
|
4901 'image)
|
|
|
4902 ((eq type '8-binary)
|
|
|
4903 (if (or (eq (car f-fs) '36-bit-wa)
|
|
|
4904 (eq (car t-fs) '36-bit-wa))
|
|
|
4905 'tenex
|
|
|
4906 'image))
|
|
|
4907 (t ; handles 'text
|
|
|
4908 (if (and t-fs f-fs (eq (nth 1 f-fs) 'ebcdic)
|
|
|
4909 (eq (nth 1 t-fs) 'ebcdic) (null via-local))
|
|
|
4910 'ebcdic
|
|
|
4911 'ascii)))))))))
|
|
|
4912
|
|
|
4913 (defun efs-set-xfer-type (host user type &optional clientless)
|
|
|
4914 ;; Sets the xfer type for HOST and USER to TYPE.
|
|
|
4915 ;; If the connection is already using the required type, does nothing.
|
|
|
4916 ;; If clientless is non-nil, we are using a quoted xfer command, and
|
|
|
4917 ;; need to check if the client has changed things.
|
|
|
4918 (save-excursion
|
|
|
4919 (let ((buff (process-buffer (efs-get-process host user))))
|
|
|
4920 (set-buffer buff)
|
|
|
4921 (or (if (and clientless efs-process-client-altered-xfer-type)
|
|
|
4922 (or (eq type efs-process-client-altered-xfer-type)
|
|
|
4923 (setq efs-process-client-altered-xfer-type nil))
|
|
|
4924 ;; We are sending a non-clientless command, so the client
|
|
|
4925 ;; gets back in synch.
|
|
|
4926 (setq efs-process-client-altered-xfer-type nil)
|
|
|
4927 (and efs-process-xfer-type
|
|
|
4928 (eq type efs-process-xfer-type)))
|
|
|
4929 (let ((otype efs-process-xfer-type))
|
|
|
4930 ;; Set this now in anticipation that the TYPE command will work,
|
|
|
4931 ;; in case other commands, such as efs-set-hash-mark-unit want to
|
|
|
4932 ;; grok this before the TYPE command completes.
|
|
|
4933 (setq efs-process-xfer-type type)
|
|
|
4934 (efs-send-cmd
|
|
|
4935 host user (list 'type type)
|
|
|
4936 nil nil
|
|
|
4937 (efs-cont (result line cont-lines) (host user type otype buff)
|
|
|
4938 (if result
|
|
|
4939 (unwind-protect
|
|
|
4940 (efs-error host user (format "TYPE %s failed: %s"
|
|
|
4941 (upcase (symbol-name type))
|
|
|
4942 line))
|
|
|
4943 (if (get-buffer buff)
|
|
|
4944 (save-excursion
|
|
|
4945 (set-buffer buff)
|
|
|
4946 (setq efs-process-xfer-type otype))))))
|
|
|
4947 0)))))) ; always send type commands NOWAIT = 0
|
|
|
4948
|
|
|
4949
|
|
|
4950 ;;;; ------------------------------------------------------------
|
|
|
4951 ;;;; Obtaining DIR listings.
|
|
|
4952 ;;;; ------------------------------------------------------------
|
|
|
4953
|
|
|
4954 (defun efs-ls-guess-switches ()
|
|
|
4955 ;; Tries to determine what would be the most useful switches
|
|
|
4956 ;; to use for a DIR listing.
|
|
|
4957 (if (and (boundp 'dired-listing-switches)
|
|
|
4958 (stringp dired-listing-switches)
|
|
|
4959 (efs-parsable-switches-p dired-listing-switches t))
|
|
|
4960 dired-listing-switches
|
|
|
4961 "-al"))
|
|
|
4962
|
|
|
4963 (efs-defun efs-ls-dumb-check nil (line host file path lsargs msg noparse
|
|
|
4964 noerror nowait cont)
|
|
|
4965 nil)
|
|
|
4966
|
|
|
4967 (efs-defun efs-ls-dumb-check unknown (line host file path lsargs
|
|
|
4968 msg noparse noerror nowait cont)
|
|
|
4969 ;; Checks to see if the host type might be dumb unix. If so, returns the
|
|
|
4970 ;; listing otherwise nil.
|
|
|
4971 (and
|
|
|
4972 lsargs
|
|
|
4973 (string-match
|
|
|
4974 ;; Some CMU servers return a 530 here. 550 is correct.
|
|
|
4975 (concat "^5[35]0 \\(The file \\)?"
|
|
|
4976 (regexp-quote (concat lsargs " " path)))
|
|
|
4977 ;; 550 is for a non-accessible file -- RFC959
|
|
|
4978 line)
|
|
|
4979 (progn
|
|
|
4980 (if (eq (efs-host-type host) 'apollo-unix)
|
|
|
4981 (efs-add-host 'dumb-apollo-unix host)
|
|
|
4982 (efs-add-host 'dumb-unix host))
|
|
|
4983 ;; try again
|
|
|
4984 (if nowait
|
|
|
4985 t ; return t if asynch
|
|
|
4986 ; This is because dumb-check can't run asynch.
|
|
|
4987 ; This means that we can't recognize dumb hosts asynch.
|
|
|
4988 ; Shouldn't be a problem.
|
|
|
4989 (efs-ls file nil
|
|
|
4990 (if (eq msg t)
|
|
|
4991 (format "Relisting %s" (efs-relativize-filename file))
|
|
|
4992 msg)
|
|
|
4993 noparse noerror nowait cont)))))
|
|
|
4994
|
|
|
4995 ;; With no-error nil, this function returns:
|
|
|
4996 ;; an error if file is not an efs-path
|
|
|
4997 ;; (This should never happen.)
|
|
|
4998 ;; an error if either the listing is unreadable or there is an ftp error.
|
|
|
4999 ;; the listing (a string), if everything works.
|
|
|
5000 ;;
|
|
|
5001 ;; With no-error t, it returns:
|
|
|
5002 ;; an error if not an efs-path
|
|
|
5003 ;; error if listing is unreable (most likely caused by a slow connection)
|
|
|
5004 ;; nil if ftp error (this is because although asking to list a nonexistent
|
|
|
5005 ;; directory on a remote unix machine usually (except
|
|
|
5006 ;; maybe for dumb hosts) returns an ls error, but no
|
|
|
5007 ;; ftp error, if the same is done on a VMS machine,
|
|
|
5008 ;; an ftp error is returned. Need to trap the error
|
|
|
5009 ;; so we can go on and try to list the parent.)
|
|
|
5010 ;; the listing, if everything works.
|
|
|
5011
|
|
|
5012 (defun efs-ls (file lsargs msg &optional noparse noerror nowait cont nlist)
|
|
|
5013 "Return the output of a `DIR' or `ls' command done over ftp.
|
|
|
5014 FILE is the full name of the remote file, LSARGS is any args to pass to the
|
|
|
5015 `ls' command. MSG is a message to be displayed while listing, if MSG is given
|
|
|
5016 as t, a suitable message will be computed. If nil, no message will be
|
|
|
5017 displayed. If NOPARSE is non-nil, then the listing will not be parsed and
|
|
|
5018 stored in internal cache. Otherwise, the listing will be parsed, if LSARGS
|
|
|
5019 allow it. If NOERROR is non-nil, then we return nil if the listing fails,
|
|
|
5020 rather than signal an error. If NOWAIT is non-nil, we do the listing
|
|
|
5021 asynchronously, returning nil. If CONT is non-nil it is called with first
|
|
|
5022 argument the listing string."
|
|
|
5023 ;; If lsargs are nil, this forces a one-time only dumb listing using dir.
|
|
|
5024 (setq file (efs-expand-file-name file))
|
|
|
5025 (let ((parsed (efs-ftp-path file)))
|
|
|
5026 (if parsed
|
|
|
5027 (let* ((host (nth 0 parsed))
|
|
|
5028 (user (nth 1 parsed))
|
|
|
5029 (path (nth 2 parsed))
|
|
|
5030 (host-type (efs-host-type host user))
|
|
|
5031 (listing-type (efs-listing-type host user))
|
|
|
5032 (parse (cond
|
|
|
5033 ((null noparse)
|
|
|
5034 (efs-parsable-switches-p lsargs t))
|
|
|
5035 ((eq noparse 'parse)
|
|
|
5036 t)
|
|
|
5037 (t nil)))
|
|
|
5038 (switches lsargs)
|
|
|
5039 cache)
|
|
|
5040
|
|
|
5041 (if (memq host-type efs-dumb-host-types)
|
|
|
5042 (setq lsargs nil))
|
|
|
5043 (if (and (null efs-ls-uncache)
|
|
|
5044 (setq cache
|
|
|
5045 (or (efs-get-from-ls-cache file switches)
|
|
|
5046 (and switches
|
|
|
5047 (efs-convert-from-ls-cache
|
|
|
5048 file switches host-type listing-type)))))
|
|
|
5049 ;; The listing is in the mail, errr... cache.
|
|
|
5050 (let (listing)
|
|
|
5051 (if (stringp cache)
|
|
|
5052 (setq listing cache)
|
|
|
5053 (setq listing (car cache))
|
|
|
5054 (if (and parse (null (nth 1 cache)))
|
|
|
5055 (save-excursion
|
|
|
5056 (set-buffer
|
|
|
5057 (let ((default-major-mode 'fundamental-mode))
|
|
|
5058 (get-buffer-create
|
|
|
5059 efs-data-buffer-name)))
|
|
|
5060 (erase-buffer)
|
|
|
5061 (insert listing)
|
|
|
5062 (goto-char (point-min))
|
|
|
5063 (efs-set-files
|
|
|
5064 file
|
|
|
5065 (efs-parse-listing listing-type
|
|
|
5066 host user path
|
|
|
5067 file lsargs))
|
|
|
5068 ;; Note that we have parsed it now.
|
|
|
5069 (setcar (cdr cache) t))))
|
|
|
5070 (if cont (efs-call-cont cont listing))
|
|
|
5071 listing)
|
|
|
5072
|
|
|
5073 (if cache
|
|
|
5074 (efs-del-from-ls-cache file nil nil))
|
|
|
5075 ;; Need to get the listing via FTP.
|
|
|
5076 (let* ((temp (efs-make-tmp-name host nil))
|
|
|
5077 (temp-file (car temp))
|
|
|
5078 listing-result)
|
|
|
5079 (efs-send-cmd
|
|
|
5080 host user
|
|
|
5081 (list (if nlist 'nlist 'dir) path (cdr temp) lsargs)
|
|
|
5082 (if (eq msg t)
|
|
|
5083 (format "Listing %s" (efs-relativize-filename file))
|
|
|
5084 msg)
|
|
|
5085 nil
|
|
|
5086 (efs-cont (result line cont-lines)
|
|
|
5087 (host-type listing-type host user temp-file path
|
|
|
5088 switches file lsargs noparse parse noerror
|
|
|
5089 msg nowait cont)
|
|
|
5090 ;; The client flipped to ascii, remember this.
|
|
|
5091 (let ((buff (get-buffer
|
|
|
5092 (efs-ftp-process-buffer host user))))
|
|
|
5093 (if buff
|
|
|
5094 (efs-save-buffer-excursion
|
|
|
5095 (set-buffer buff)
|
|
|
5096 (setq efs-process-client-altered-xfer-type
|
|
|
5097 'ascii))))
|
|
|
5098 (unwind-protect
|
|
|
5099 (if result
|
|
|
5100 (or (setq listing-result
|
|
|
5101 (efs-ls-dumb-check
|
|
|
5102 (and (or (eq host-type 'unknown)
|
|
|
5103 (eq listing-type 'unix:unknown))
|
|
|
5104 'unknown)
|
|
|
5105 line host file path lsargs msg
|
|
|
5106 noparse noerror nowait cont))
|
|
|
5107 ;; If dumb-check returns non-nil
|
|
|
5108 ;; then it would have handled any error recovery
|
|
|
5109 ;; and conts. listing-result would only be set to
|
|
|
5110 ;; t if nowait was non-nil. Therefore, the final
|
|
|
5111 ;; return for efs-ls could never be t, even if I
|
|
|
5112 ;; set listing-result to t here.
|
|
|
5113 (if noerror
|
|
|
5114 (if cont
|
|
|
5115 (efs-call-cont cont nil))
|
|
|
5116 (efs-error host user
|
|
|
5117 (concat "DIR failed: "
|
|
|
5118 line))))
|
|
|
5119
|
|
|
5120 ;; listing worked
|
|
|
5121 (if (efs-ftp-path temp-file)
|
|
|
5122 (efs-add-file-entry (efs-host-type efs-gateway-host)
|
|
|
5123 temp-file nil nil nil))
|
|
|
5124 (save-excursion
|
|
|
5125 ;; A hack to get around a jka-compr problem.
|
|
|
5126 ;; Do we still need it?
|
|
|
5127 (let ((default-major-mode 'fundamental-mode)
|
|
|
5128 efs-verbose jka-compr-enabled)
|
|
|
5129 (set-buffer (get-buffer-create
|
|
|
5130 efs-data-buffer-name))
|
|
|
5131 (erase-buffer)
|
|
|
5132 (if (or (file-readable-p temp-file)
|
|
|
5133 (sleep-for efs-retry-time)
|
|
|
5134 (file-readable-p temp-file))
|
|
|
5135 (insert-file-contents temp-file)
|
|
|
5136 (efs-error host user
|
|
|
5137 (format
|
|
|
5138 "list data file %s not readable"
|
|
|
5139 temp-file))))
|
|
|
5140 (if parse
|
|
|
5141 (progn
|
|
|
5142 (efs-set-files
|
|
|
5143 file
|
|
|
5144 (efs-parse-listing listing-type host user path
|
|
|
5145 file lsargs))
|
|
|
5146 ;; Parsing may update the host type.
|
|
|
5147 (and lsargs (memq (efs-host-type host)
|
|
|
5148 efs-dumb-host-types)
|
|
|
5149 (setq lsargs nil))))
|
|
|
5150 (let ((listing (buffer-string)))
|
|
|
5151 (efs-add-to-ls-cache file lsargs listing parse)
|
|
|
5152 (if (and (null lsargs) switches)
|
|
|
5153 ;; Try to convert
|
|
|
5154 (let ((conv (efs-get-ls-converter switches)))
|
|
|
5155 (and conv
|
|
|
5156 (setq conv (assoc
|
|
|
5157 (char-to-string 0)
|
|
|
5158 conv))
|
|
|
5159 (funcall (cdr conv) listing-type nil)
|
|
|
5160 (setq listing (buffer-string)))))
|
|
|
5161 (or nowait (setq listing-result listing))
|
|
|
5162 ;; Call the ls cont, with first arg the
|
|
|
5163 ;; listing string.
|
|
|
5164 (if cont
|
|
|
5165 (efs-call-cont cont listing)))))
|
|
|
5166 (efs-del-tmp-name temp-file)))
|
|
|
5167 nowait)
|
|
|
5168 (and (null nowait) listing-result))))
|
|
|
5169 (error "Attempt to get a remote listing for the local file %s" file))))
|
|
|
5170
|
|
|
5171
|
|
|
5172 ;;;; ===============================================================
|
|
|
5173 ;;;; >7
|
|
|
5174 ;;;; Parsing and storing remote file system data.
|
|
|
5175 ;;;; ===============================================================
|
|
|
5176
|
|
|
5177 ;;; The directory listing parsers do some host type guessing.
|
|
|
5178 ;;; Most of the host type guessing is done when the PWD output
|
|
|
5179 ;;; is parsed. A bit is done when the error codes for DIR are
|
|
|
5180 ;;; analyzed.
|
|
|
5181
|
|
|
5182 ;;;; -----------------------------------------------------------
|
|
|
5183 ;;;; Caching directory listings.
|
|
|
5184 ;;;; -----------------------------------------------------------
|
|
|
5185
|
|
|
5186 ;;; Aside from storing files data in a hashtable, a limited number
|
|
|
5187 ;;; of listings are stored in complete form in `efs-ls-cache'.
|
|
|
5188
|
|
|
5189 (defun efs-del-from-ls-cache (file &optional parent-p dir-p)
|
|
|
5190 ;; Deletes from the ls cache the listing for FILE.
|
|
|
5191 ;; With optional PARENT-P, deletes any entry for the parent
|
|
|
5192 ;; directory of FILE too.
|
|
|
5193 ;; If DIR-P is non-nil, then the directory listing of FILE is to be deleted.
|
|
|
5194 (if dir-p
|
|
|
5195 (setq file (file-name-as-directory file))
|
|
|
5196 (setq file (directory-file-name file)))
|
|
|
5197 (setq file (efs-canonize-file-name file))
|
|
|
5198 (if parent-p
|
|
|
5199 (setq parent-p (file-name-directory
|
|
|
5200 (if dir-p
|
|
|
5201 (directory-file-name file)
|
|
|
5202 file))))
|
|
|
5203 (setq efs-ls-cache
|
|
|
5204 (delq nil
|
|
|
5205 (mapcar
|
|
|
5206 (if parent-p
|
|
|
5207 (function
|
|
|
5208 (lambda (x)
|
|
|
5209 (let ((f-ent (car x)))
|
|
|
5210 (and (not (string-equal file f-ent))
|
|
|
5211 (not (string-equal parent-p f-ent))
|
|
|
5212 x))))
|
|
|
5213 (function
|
|
|
5214 (lambda (x)
|
|
|
5215 (and (not (string-equal file (car x)))
|
|
|
5216 x))))
|
|
|
5217 efs-ls-cache))))
|
|
|
5218
|
|
|
5219 (defun efs-wipe-from-ls-cache (host user)
|
|
|
5220 ;; Remove from efs-ls-cache all listings for HOST and USER.
|
|
|
5221 (let ((host (downcase host))
|
|
|
5222 (case-insens (memq (efs-host-type host)
|
|
|
5223 efs-case-insensitive-host-types)))
|
|
|
5224 (if case-insens (setq user (downcase user)))
|
|
|
5225 (setq efs-ls-cache
|
|
|
5226 (delq nil
|
|
|
5227 (mapcar
|
|
|
5228 (function
|
|
|
5229 (lambda (x)
|
|
|
5230 (let ((parsed (efs-ftp-path (car x))))
|
|
|
5231 (and (not
|
|
|
5232 (and (string-equal (car parsed) host)
|
|
|
5233 (string-equal (if case-insens
|
|
|
5234 (downcase (nth 1 parsed))
|
|
|
5235 (nth 1 parsed))
|
|
|
5236 user)))
|
|
|
5237 x))))
|
|
|
5238 efs-ls-cache)))))
|
|
|
5239
|
|
|
5240 (defun efs-get-from-ls-cache (file switches)
|
|
|
5241 ;; Returns the value in `ls-cache' for FILE and SWITCHES.
|
|
|
5242 ;; Returns a list consisting of the listing string, and whether its
|
|
|
5243 ;; already been parsed. This list is eq to the nthcdr 2 of the actual
|
|
|
5244 ;; cache entry, so you can setcar it.
|
|
|
5245 ;; For dumb listings, SWITCHES will be nil.
|
|
|
5246 (let ((list efs-ls-cache)
|
|
|
5247 (switches (efs-canonize-switches switches))
|
|
|
5248 (file (efs-canonize-file-name file)))
|
|
|
5249 (catch 'done
|
|
|
5250 (while list
|
|
|
5251 (if (and (string-equal file (car (car list)))
|
|
|
5252 (string-equal switches (nth 1 (car list))))
|
|
|
5253 (throw 'done (nthcdr 2 (car list)))
|
|
|
5254 (setq list (cdr list)))))))
|
|
|
5255
|
|
|
5256 (defun efs-add-to-ls-cache (file switches listing parsed)
|
|
|
5257 ;; Only call after efs-get-from-cache returns nil, to avoid duplicate
|
|
|
5258 ;; entries. PARSED should be t, if the listing has already been parsed.
|
|
|
5259 (and (> efs-ls-cache-max 0)
|
|
|
5260 (let ((switches (efs-canonize-switches switches))
|
|
|
5261 (file (efs-canonize-file-name file)))
|
|
|
5262 (if (= efs-ls-cache-max 1)
|
|
|
5263 (setq efs-ls-cache
|
|
|
5264 (list (list file switches listing parsed)))
|
|
|
5265 (if (>= (length efs-ls-cache) efs-ls-cache-max)
|
|
|
5266 (setcdr (nthcdr (- efs-ls-cache-max 2) efs-ls-cache) nil))
|
|
|
5267 (setq efs-ls-cache (cons (list file switches listing parsed)
|
|
|
5268 efs-ls-cache))))))
|
|
|
5269
|
|
|
5270 ;;;; --------------------------------------------------------------
|
|
|
5271 ;;;; Converting listings from cache.
|
|
|
5272 ;;;; --------------------------------------------------------------
|
|
|
5273
|
|
|
5274 (defun efs-get-ls-converter (to-switches)
|
|
|
5275 ;; Returns converter alist for TO-SWITCHES
|
|
|
5276 (efs-get-hash-entry (efs-canonize-switches to-switches)
|
|
|
5277 efs-ls-converter-hashtable))
|
|
|
5278
|
|
|
5279 (defun efs-add-ls-converter (to-switches from-switches converter)
|
|
|
5280 ;; Adds an entry to `efs-ls-converter-hashtable'.
|
|
|
5281 ;; If from-switches is t, the converter converts from internal files
|
|
|
5282 ;; hashtable.
|
|
|
5283 (let* ((to-switches (efs-canonize-switches to-switches))
|
|
|
5284 (ent (efs-get-hash-entry to-switches efs-ls-converter-hashtable))
|
|
|
5285 (add (cons (or (eq from-switches t)
|
|
|
5286 (efs-canonize-switches from-switches))
|
|
|
5287 converter)))
|
|
|
5288 (if ent
|
|
|
5289 (or (member add ent)
|
|
|
5290 (nconc ent (list add)))
|
|
|
5291 (efs-put-hash-entry to-switches (list add) efs-ls-converter-hashtable))))
|
|
|
5292
|
|
|
5293 (defun efs-convert-from-ls-cache (file switches host-type listing-type)
|
|
|
5294 ;; Returns a listing by converting the switches from a cached listing.
|
|
|
5295 (let ((clist (efs-get-ls-converter switches))
|
|
|
5296 (dir-p (= ?/ (aref file (1- (length file)))))
|
|
|
5297 elt listing result regexp alist)
|
|
|
5298 (while file ; this loop will iterate at most twice.
|
|
|
5299 (setq alist clist)
|
|
|
5300 (while alist
|
|
|
5301 (setq elt (car alist))
|
|
|
5302 (if (eq (car elt) t)
|
|
|
5303 (if (and dir-p (setq result (funcall (cdr elt) host-type
|
|
|
5304 (let ((efs-ls-uncache t))
|
|
|
5305 (efs-get-files file))
|
|
|
5306 regexp)))
|
|
|
5307 (setq alist nil
|
|
|
5308 file nil)
|
|
|
5309 (setq alist (cdr alist)))
|
|
|
5310 (if (and (setq listing
|
|
|
5311 (efs-get-from-ls-cache file (car elt)))
|
|
|
5312 (save-excursion
|
|
|
5313 (set-buffer
|
|
|
5314 (let ((default-major-mode 'fundamental-mode))
|
|
|
5315 (get-buffer-create efs-data-buffer-name)))
|
|
|
5316 (erase-buffer)
|
|
|
5317 (insert (car listing))
|
|
|
5318 (and (funcall (cdr elt) listing-type regexp)
|
|
|
5319 (setq result (buffer-string)))))
|
|
|
5320 (setq alist nil
|
|
|
5321 file nil)
|
|
|
5322 (setq alist (cdr alist)))))
|
|
|
5323 ;; Look for wildcards.
|
|
|
5324 (if (and file (null dir-p) (null regexp))
|
|
|
5325 (setq regexp (efs-shell-regexp-to-regexp
|
|
|
5326 (file-name-nondirectory file))
|
|
|
5327 file (file-name-directory file)
|
|
|
5328 dir-p t)
|
|
|
5329 (setq file nil)))
|
|
|
5330 result))
|
|
|
5331
|
|
|
5332 ;;; Define some converters
|
|
|
5333
|
|
|
5334 (defun efs-unix-t-converter-sort-pred (elt1 elt2)
|
|
|
5335 (let* ((data1 (car elt1))
|
|
|
5336 (data2 (car elt2))
|
|
|
5337 (year1 (car data1))
|
|
|
5338 (year2 (car data2))
|
|
|
5339 (month1 (nth 1 data1))
|
|
|
5340 (month2 (nth 1 data2))
|
|
|
5341 (day1 (nth 2 data1))
|
|
|
5342 (day2 (nth 2 data2))
|
|
|
5343 (hour1 (nth 3 data1))
|
|
|
5344 (hour2 (nth 3 data2))
|
|
|
5345 (minutes1 (nth 4 data1))
|
|
|
5346 (minutes2 (nth 4 data2)))
|
|
|
5347 (if year1
|
|
|
5348 (and year2
|
|
|
5349 (or (> year1 year2)
|
|
|
5350 (and (= year1 year2)
|
|
|
5351 (or (> month1 month2)
|
|
|
5352 (and (= month1 month2)
|
|
|
5353 (> day1 day2))))))
|
|
|
5354 (if year2
|
|
|
5355 t
|
|
|
5356 (or (> month1 month2)
|
|
|
5357 (and (= month1 month2)
|
|
|
5358 (or (> day1 day2)
|
|
|
5359 (and (= day1 day2)
|
|
|
5360 (or (> hour1 hour2)
|
|
|
5361 (and (= hour1 hour2)
|
|
|
5362 (> minutes1 minutes2)))))))))))
|
|
|
5363
|
|
|
5364 (defun efs-unix-t-converter (&optional regexp reverse)
|
|
|
5365 (if regexp
|
|
|
5366 nil
|
|
|
5367 (goto-char (point-min))
|
|
|
5368 (efs-save-match-data
|
|
|
5369 (if (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
5370 (let ((current-month (cdr (assoc (substring
|
|
|
5371 (current-time-string) 4 7)
|
|
|
5372 efs-month-alist)))
|
|
|
5373 list-start start end list year month day hour minutes)
|
|
|
5374 (beginning-of-line)
|
|
|
5375 (setq list-start (point))
|
|
|
5376 (while (progn
|
|
|
5377 (setq start (point))
|
|
|
5378 (forward-line 1)
|
|
|
5379 (setq end (point))
|
|
|
5380 (goto-char start)
|
|
|
5381 (re-search-forward efs-month-and-time-regexp end t))
|
|
|
5382 ;; Need to measure wrto the current month
|
|
|
5383 ;; There is a bug here if because of time-zone shifts, the
|
|
|
5384 ;; local machine and the remote one are on different months.
|
|
|
5385 (setq month (% (+ (- 11 current-month)
|
|
|
5386 (cdr (assoc
|
|
|
5387 (buffer-substring (match-beginning 2)
|
|
|
5388 (match-end 2))
|
|
|
5389 efs-month-alist))) 12)
|
|
|
5390 day (string-to-int
|
|
|
5391 (buffer-substring (match-beginning 3) (match-end 3)))
|
|
|
5392 year (buffer-substring (match-beginning 4) (match-end 4)))
|
|
|
5393 (if (string-match ":" year)
|
|
|
5394 (setq hour (string-to-int (substring year 0
|
|
|
5395 (match-beginning 0)))
|
|
|
5396 minutes (string-to-int (substring year (match-end 0)))
|
|
|
5397 year nil)
|
|
|
5398 (setq hour nil
|
|
|
5399 minutes nil
|
|
|
5400 year (string-to-int year)))
|
|
|
5401 (setq list (cons
|
|
|
5402 (cons
|
|
|
5403 (list year month day hour minutes)
|
|
|
5404 (buffer-substring start end))
|
|
|
5405 list))
|
|
|
5406 (goto-char end))
|
|
|
5407 (setq list
|
|
|
5408 (mapcar 'cdr
|
|
|
5409 (sort list 'efs-unix-t-converter-sort-pred)))
|
|
|
5410 (if reverse (setq list (nreverse list)))
|
|
|
5411 (delete-region list-start (point))
|
|
|
5412 (apply 'insert list)
|
|
|
5413 t)))))
|
|
|
5414
|
|
|
5415 (efs-defun efs-t-converter nil (&optional regexp reverse)
|
|
|
5416 ;; Converts listing without the t-switch, to ones with it.
|
|
|
5417 nil) ; by default assume that we cannot work.
|
|
|
5418
|
|
|
5419 (efs-fset 'efs-t-converter 'unix 'efs-unix-t-converter)
|
|
|
5420 (efs-fset 'efs-t-converter 'sysV-unix 'efs-unix-t-converter)
|
|
|
5421 (efs-fset 'efs-t-converter 'apollo-unix 'efs-unix-t-converter)
|
|
|
5422 (efs-fset 'efs-t-converter 'bsd-unix 'efs-unix-t-converter)
|
|
|
5423 (efs-fset 'efs-t-converter 'dumb-unix 'efs-unix-t-converter)
|
|
|
5424 (efs-fset 'efs-t-converter 'dumb-apollo-unix 'efs-unix-t-converter)
|
|
|
5425 (efs-fset 'efs-t-converter 'super-dumb-unix 'efs-unix-t-converter)
|
|
|
5426
|
|
|
5427 (defun efs-rt-converter (listing-type &optional regexp)
|
|
|
5428 ;; Reverse time sorting
|
|
|
5429 (efs-t-converter listing-type regexp t))
|
|
|
5430
|
|
|
5431 (defun efs-unix-alpha-converter (&optional regexp reverse)
|
|
|
5432 (if regexp
|
|
|
5433 nil
|
|
|
5434 (goto-char (point-min))
|
|
|
5435 (efs-save-match-data
|
|
|
5436 (if (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
5437 (let (list list-start end start next)
|
|
|
5438 (beginning-of-line)
|
|
|
5439 (setq list-start (point))
|
|
|
5440 (while (progn
|
|
|
5441 (setq start (point))
|
|
|
5442 (end-of-line)
|
|
|
5443 (setq end (point)
|
|
|
5444 next (1+ end))
|
|
|
5445 (goto-char start)
|
|
|
5446 (re-search-forward efs-month-and-time-regexp end t))
|
|
|
5447 ;; Need to measure wrto the current month
|
|
|
5448 ;; There is a bug here if because of time-zone shifts, the
|
|
|
5449 ;; local machine and the remote one are on different months.
|
|
|
5450 (setq list
|
|
|
5451 (cons
|
|
|
5452 (cons (buffer-substring (point) end)
|
|
|
5453 (buffer-substring start next))
|
|
|
5454 list))
|
|
|
5455 (goto-char next))
|
|
|
5456 (delete-region list-start (point))
|
|
|
5457 (apply 'insert
|
|
|
5458 (mapcar 'cdr
|
|
|
5459 (sort list (if reverse
|
|
|
5460 (function
|
|
|
5461 (lambda (x y)
|
|
|
5462 (string< (car y) (car x))))
|
|
|
5463 (function
|
|
|
5464 (lambda (x y)
|
|
|
5465 (string< (car x) (car y))))))))
|
|
|
5466 t)))))
|
|
|
5467
|
|
|
5468 (efs-defun efs-alpha-converter nil (&optional regexp reverse)
|
|
|
5469 ;; Converts listing to lexigraphical order.
|
|
|
5470 nil) ; by default assume that we cannot work.
|
|
|
5471
|
|
|
5472 (efs-fset 'efs-alpha-converter 'unix 'efs-unix-alpha-converter)
|
|
|
5473 (efs-fset 'efs-alpha-converter 'sysV-unix 'efs-unix-alpha-converter)
|
|
|
5474 (efs-fset 'efs-alpha-converter 'apollo-unix 'efs-unix-alpha-converter)
|
|
|
5475 (efs-fset 'efs-alpha-converter 'bsd-unix 'efs-unix-alpha-converter)
|
|
|
5476 (efs-fset 'efs-alpha-converter 'dumb-unix 'efs-unix-alpha-converter)
|
|
|
5477 (efs-fset 'efs-alpha-converter 'dumb-apollo-unix 'efs-unix-alpha-converter)
|
|
|
5478 (efs-fset 'efs-alpha-converter 'super-dumb-unix 'efs-unix-alpha-converter)
|
|
|
5479
|
|
|
5480 (defun efs-ralpha-converter (listing-type &optional regexp)
|
|
|
5481 ;; Reverse alphabetic
|
|
|
5482 (efs-alpha-converter listing-type regexp t))
|
|
|
5483
|
|
|
5484 (defun efs-unix-S-converter (&optional regexp reverse)
|
|
|
5485 (if regexp
|
|
|
5486 nil
|
|
|
5487 (goto-char (point-min))
|
|
|
5488 (efs-save-match-data
|
|
|
5489 (if (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
5490 (let (list list-start start next)
|
|
|
5491 (beginning-of-line)
|
|
|
5492 (setq list-start (point))
|
|
|
5493 (while (progn
|
|
|
5494 (setq start (point))
|
|
|
5495 (forward-line 1)
|
|
|
5496 (setq next (point))
|
|
|
5497 (goto-char start)
|
|
|
5498 (re-search-forward efs-month-and-time-regexp next t))
|
|
|
5499 ;; Need to measure wrto the current month
|
|
|
5500 ;; There is a bug here if because of time-zone shifts, the
|
|
|
5501 ;; local machine and the remote one are on different months.
|
|
|
5502 (setq list
|
|
|
5503 (cons
|
|
|
5504 (cons (string-to-int
|
|
|
5505 (buffer-substring (match-beginning 1)
|
|
|
5506 (match-end 1)))
|
|
|
5507 (buffer-substring start next))
|
|
|
5508 list))
|
|
|
5509 (goto-char next))
|
|
|
5510 (delete-region list-start (point))
|
|
|
5511 (apply 'insert
|
|
|
5512 (mapcar 'cdr
|
|
|
5513 (sort list (if reverse
|
|
|
5514 (function
|
|
|
5515 (lambda (x y)
|
|
|
5516 (< (car x) (car y))))
|
|
|
5517 (function
|
|
|
5518 (lambda (x y)
|
|
|
5519 (> (car x) (car y))))))))
|
|
|
5520 t)))))
|
|
|
5521
|
|
|
5522 (efs-defun efs-S-converter nil (&optional regexp reverse)
|
|
|
5523 ;; Converts listing without the S-switch, to ones with it.
|
|
|
5524 nil) ; by default assume that we cannot work.
|
|
|
5525
|
|
|
5526 (efs-fset 'efs-S-converter 'unix 'efs-unix-S-converter)
|
|
|
5527 (efs-fset 'efs-S-converter 'sysV-unix 'efs-unix-S-converter)
|
|
|
5528 (efs-fset 'efs-S-converter 'apollo-unix 'efs-unix-S-converter)
|
|
|
5529 (efs-fset 'efs-S-converter 'bsd-unix 'efs-unix-S-converter)
|
|
|
5530 (efs-fset 'efs-S-converter 'dumb-unix 'efs-unix-S-converter)
|
|
|
5531 (efs-fset 'efs-S-converter 'dumb-apollo-unix 'efs-unix-S-converter)
|
|
|
5532 (efs-fset 'efs-S-converter 'super-dumb-unix 'efs-unix-S-converter)
|
|
|
5533
|
|
|
5534 (defun efs-rS-converter (listing-type &optional regexp)
|
|
|
5535 ;; Reverse S switch.
|
|
|
5536 (efs-S-converter listing-type regexp t))
|
|
|
5537
|
|
|
5538 (defun efs-unix-X-converter (&optional regexp reverse)
|
|
|
5539 (if regexp
|
|
|
5540 nil
|
|
|
5541 (goto-char (point-min))
|
|
|
5542 (efs-save-match-data
|
|
|
5543 (if (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
5544 (let (next list list-start fnstart eol start end link-p)
|
|
|
5545 (beginning-of-line)
|
|
|
5546 (setq list-start (point))
|
|
|
5547 (while (progn
|
|
|
5548 (setq start (point))
|
|
|
5549 (skip-chars-forward "0-9 ")
|
|
|
5550 (setq link-p (= (following-char) ?l))
|
|
|
5551 (end-of-line)
|
|
|
5552 (setq eol (point)
|
|
|
5553 next (1+ eol))
|
|
|
5554 (goto-char start)
|
|
|
5555 (re-search-forward efs-month-and-time-regexp eol t))
|
|
|
5556 ;; Need to measure wrto the current month
|
|
|
5557 ;; There is a bug here if because of time-zone shifts, the
|
|
|
5558 ;; local machine and the remote one are on different months.
|
|
|
5559 (setq fnstart (point))
|
|
|
5560 (or (and link-p (search-forward " -> " eol t)
|
|
|
5561 (goto-char (match-beginning 0)))
|
|
|
5562 (goto-char eol))
|
|
|
5563 (setq end (point))
|
|
|
5564 (skip-chars-backward "^." fnstart)
|
|
|
5565 (setq list
|
|
|
5566 (cons
|
|
|
5567 (cons
|
|
|
5568 (if (= (point) fnstart)
|
|
|
5569 ""
|
|
|
5570 (buffer-substring (point) end))
|
|
|
5571 (buffer-substring start next))
|
|
|
5572 list))
|
|
|
5573 (goto-char next))
|
|
|
5574 (delete-region list-start (point))
|
|
|
5575 (apply 'insert
|
|
|
5576 (mapcar 'cdr
|
|
|
5577 (sort list (if reverse
|
|
|
5578 (function
|
|
|
5579 (lambda (x y)
|
|
|
5580 (string< (car y) (car x))))
|
|
|
5581 (function
|
|
|
5582 (lambda (x y)
|
|
|
5583 (string< (car x) (car y))))))))
|
|
|
5584 t)))))
|
|
|
5585
|
|
|
5586 (efs-defun efs-X-converter nil (&optional regexp reverse)
|
|
|
5587 ;; Sort on file name extension. By default do nothing
|
|
|
5588 nil)
|
|
|
5589
|
|
|
5590 (defun efs-rX-converter (listing-type &optional regexp)
|
|
|
5591 (efs-X-converter listing-type regexp t))
|
|
|
5592
|
|
|
5593 (efs-fset 'efs-X-converter 'unix 'efs-unix-X-converter)
|
|
|
5594 (efs-fset 'efs-X-converter 'sysV-unix 'efs-unix-X-converter)
|
|
|
5595 (efs-fset 'efs-X-converter 'apollo-unix 'efs-unix-X-converter)
|
|
|
5596 (efs-fset 'efs-X-converter 'bsd-unix 'efs-unix-X-converter)
|
|
|
5597 (efs-fset 'efs-X-converter 'dumb-unix 'efs-unix-X-converter)
|
|
|
5598 (efs-fset 'efs-X-converter 'dumb-apollo-unix 'efs-unix-X-converter)
|
|
|
5599 (efs-fset 'efs-X-converter 'super-dumb-unix 'efs-unix-X-converter)
|
|
|
5600
|
|
|
5601 ;;; Brief listings
|
|
|
5602
|
|
|
5603 ;;; The following functions do a heap better at packing than
|
|
|
5604 ;;; the usual ls listing. A variable column width is used.
|
|
|
5605 (defun efs-column-widths (columns list &optional across)
|
|
|
5606 ;; Returns the column widths for breaking LIST into
|
|
|
5607 ;; COLUMNS number of columns.
|
|
|
5608 (cond
|
|
|
5609 ((null list)
|
|
|
5610 nil)
|
|
|
5611 ((= columns 1)
|
|
|
5612 (list (apply 'max (mapcar 'length list))))
|
|
|
5613 ((let* ((len (length list))
|
|
|
5614 (col-length (/ len columns))
|
|
|
5615 (remainder (% len columns))
|
|
|
5616 (i 0)
|
|
|
5617 (j 0)
|
|
|
5618 (max-width 0)
|
|
|
5619 widths padding)
|
|
|
5620 (if (zerop remainder)
|
|
|
5621 (setq padding 0)
|
|
|
5622 (setq col-length (1+ col-length)
|
|
|
5623 padding (- columns remainder)))
|
|
|
5624 (setq list (nconc (copy-sequence list) (make-list padding nil)))
|
|
|
5625 (setcdr (nthcdr (1- (+ len padding)) list) list)
|
|
|
5626 (while (< i columns)
|
|
|
5627 (while (< j col-length)
|
|
|
5628 (setq max-width (max max-width (length (car list)))
|
|
|
5629 list (if across (nthcdr columns list) (cdr list))
|
|
|
5630 j (1+ j)))
|
|
|
5631 (setq widths (cons (+ max-width 2) widths)
|
|
|
5632 max-width 0
|
|
|
5633 j 0
|
|
|
5634 i (1+ i))
|
|
|
5635 (if across (setq list (cdr list))))
|
|
|
5636 (setcar widths (- (car widths) 2))
|
|
|
5637 (nreverse widths)))))
|
|
|
5638
|
|
|
5639 (defun efs-calculate-columns (list &optional across)
|
|
|
5640 ;; Returns a list of integers which are the column widths that best pack
|
|
|
5641 ;; LIST, a list of strings, onto the screen.
|
|
|
5642 (and list
|
|
|
5643 (let* ((width (1- (window-width)))
|
|
|
5644 (columns (max 1 (/ width
|
|
|
5645 (+ 2 (apply 'max (mapcar 'length list))))))
|
|
|
5646 col-list last-col-list)
|
|
|
5647 (while (<= (apply '+ (setq col-list
|
|
|
5648 (efs-column-widths columns list across)))
|
|
|
5649 width)
|
|
|
5650 (setq columns (1+ columns)
|
|
|
5651 last-col-list col-list))
|
|
|
5652 (or last-col-list col-list))))
|
|
|
5653
|
|
|
5654 (defun efs-format-columns-of-files (files &optional across)
|
|
|
5655 ;; Returns the number of lines used.
|
|
|
5656 ;; If ACROSS is non-nil, sorts across rather than down the buffer, like
|
|
|
5657 ;; ls -x
|
|
|
5658 ;; A beefed up version of the function in dired. Thanks Sebastian.
|
|
|
5659 (and files
|
|
|
5660 (let* ((columns (efs-calculate-columns files across))
|
|
|
5661 (ncols (length columns))
|
|
|
5662 (ncols1 (1- ncols))
|
|
|
5663 (nfiles (length files))
|
|
|
5664 (nrows (+ (/ nfiles ncols)
|
|
|
5665 (if (zerop (% nfiles ncols)) 0 1)))
|
|
|
5666 (space-left (- (window-width) (apply '+ columns) 1))
|
|
|
5667 (stretch (/ space-left ncols1))
|
|
|
5668 (float-stretch (if (zerop ncols1) 0 (% space-left ncols1)))
|
|
|
5669 (i 0)
|
|
|
5670 (j 0)
|
|
|
5671 (result "")
|
|
|
5672 file padding)
|
|
|
5673 (setq files (nconc (copy-sequence files) ; fill up with empty fns
|
|
|
5674 (make-list (- (* ncols nrows) nfiles) "")))
|
|
|
5675 (setcdr (nthcdr (1- (length files)) files) files) ; make circular
|
|
|
5676 (while (< j nrows)
|
|
|
5677 (while (< i ncols)
|
|
|
5678 (setq result (concat result (setq file (car files))))
|
|
|
5679 (setq padding (- (nth i columns) (length file)))
|
|
|
5680 (or (= i ncols1)
|
|
|
5681 (progn
|
|
|
5682 (setq padding (+ padding stretch))
|
|
|
5683 (if (< i float-stretch) (setq padding (1+ padding)))))
|
|
|
5684 (setq result (concat result (make-string padding ?\ )))
|
|
|
5685 (setq files (if across (cdr files) (nthcdr nrows files))
|
|
|
5686 i (1+ i)))
|
|
|
5687 (setq result (concat result "\n"))
|
|
|
5688 (setq i 0
|
|
|
5689 j (1+ j))
|
|
|
5690 (or across (setq files (cdr files))))
|
|
|
5691 result)))
|
|
|
5692
|
|
|
5693 (defun efs-brief-converter (host-type file-table F a A p x C &optional regexp)
|
|
|
5694 ;; Builds a brief directory listing for file cache, with
|
|
|
5695 ;; possible switches F, a, A, p, x.
|
|
|
5696 (efs-save-match-data
|
|
|
5697 (let (list ent modes)
|
|
|
5698 (efs-map-hashtable
|
|
|
5699 (function
|
|
|
5700 (lambda (key val)
|
|
|
5701 (if (and
|
|
|
5702 (efs-really-file-p host-type key val)
|
|
|
5703 (or a
|
|
|
5704 (and A (not (or (string-equal "." key)
|
|
|
5705 (string-equal ".." key))))
|
|
|
5706 (/= (string-to-char key) ?.))
|
|
|
5707 (or (null regexp)
|
|
|
5708 (string-match regexp key)))
|
|
|
5709 (setq ent (car val)
|
|
|
5710 modes (nth 3 val)
|
|
|
5711 list (cons
|
|
|
5712 (cond ((null (or F p))
|
|
|
5713 key)
|
|
|
5714 ((eq t ent)
|
|
|
5715 (concat key "/"))
|
|
|
5716 ((cond
|
|
|
5717 ((null F)
|
|
|
5718 key)
|
|
|
5719 ((stringp ent)
|
|
|
5720 (concat key "@"))
|
|
|
5721 ((null modes)
|
|
|
5722 key)
|
|
|
5723 ((eq (string-to-char modes) ?s)
|
|
|
5724 ;; a socket
|
|
|
5725 (concat key "="))
|
|
|
5726 ((or
|
|
|
5727 (memq (elt modes 3) '(?x ?s ?t))
|
|
|
5728 (memq (elt modes 6) '(?x ?s ?t))
|
|
|
5729 (memq (elt modes 9) '(?x ?s ?t)))
|
|
|
5730 (concat key "*"))
|
|
|
5731 (t
|
|
|
5732 key))))
|
|
|
5733 list)))))
|
|
|
5734 file-table)
|
|
|
5735 (setq list (sort list 'string<))
|
|
|
5736 (if (or C x)
|
|
|
5737 (efs-format-columns-of-files list x)
|
|
|
5738 (concat (mapconcat 'identity list "\n") "\n")))))
|
|
|
5739
|
|
|
5740 ;;; Store converters.
|
|
|
5741
|
|
|
5742 ;; The cheaters.
|
|
|
5743 (efs-add-ls-converter "-al" nil (function
|
|
|
5744 (lambda (listing-type &optional regexp)
|
|
|
5745 (null regexp))))
|
|
|
5746 (efs-add-ls-converter "-Al" nil (function
|
|
|
5747 (lambda (listing-type &optional regexp)
|
|
|
5748 (null regexp))))
|
|
|
5749 (efs-add-ls-converter "-alF" nil (function
|
|
|
5750 (lambda (listing-type &optional regexp)
|
|
|
5751 (null regexp))))
|
|
|
5752 (efs-add-ls-converter "-AlF" nil (function
|
|
|
5753 (lambda (listing-type &optional regexp)
|
|
|
5754 (null regexp))))
|
|
|
5755
|
|
|
5756 (efs-add-ls-converter "-alt" "-al" 'efs-t-converter)
|
|
|
5757 (efs-add-ls-converter "-Alt" "-Al" 'efs-t-converter)
|
|
|
5758 (efs-add-ls-converter "-lt" "-l" 'efs-t-converter)
|
|
|
5759 (efs-add-ls-converter "-altF" "-alF" 'efs-t-converter)
|
|
|
5760 (efs-add-ls-converter "-AltF" "-AlF" 'efs-t-converter)
|
|
|
5761 (efs-add-ls-converter "-ltF" "-lF" 'efs-t-converter)
|
|
|
5762 (efs-add-ls-converter "-alt" nil 'efs-t-converter)
|
|
|
5763 (efs-add-ls-converter "-altF" nil 'efs-t-converter)
|
|
|
5764 (efs-add-ls-converter "-Alt" nil 'efs-t-converter) ; cheating a bit
|
|
|
5765 (efs-add-ls-converter "-AltF" nil 'efs-t-converter) ; cheating a bit
|
|
|
5766
|
|
|
5767 (efs-add-ls-converter "-altr" "-al" 'efs-rt-converter)
|
|
|
5768 (efs-add-ls-converter "-Altr" "-Al" 'efs-rt-converter)
|
|
|
5769 (efs-add-ls-converter "-ltr" "-l" 'efs-rt-converter)
|
|
|
5770 (efs-add-ls-converter "-altFr" "-alF" 'efs-rt-converter)
|
|
|
5771 (efs-add-ls-converter "-AltFr" "-AlF" 'efs-rt-converter)
|
|
|
5772 (efs-add-ls-converter "-ltFr" "-lF" 'efs-rt-converter)
|
|
|
5773 (efs-add-ls-converter "-altr" nil 'efs-rt-converter)
|
|
|
5774 (efs-add-ls-converter "-Altr" nil 'efs-rt-converter)
|
|
|
5775
|
|
|
5776 (efs-add-ls-converter "-alr" "-alt" 'efs-alpha-converter)
|
|
|
5777 (efs-add-ls-converter "-Alr" "-Alt" 'efs-alpha-converter)
|
|
|
5778 (efs-add-ls-converter "-lr" "-lt" 'efs-alpha-converter)
|
|
|
5779 (efs-add-ls-converter "-alFr" "-alFt" 'efs-alpha-converter)
|
|
|
5780 (efs-add-ls-converter "-AlFr" "-AlFt" 'efs-alpha-converter)
|
|
|
5781 (efs-add-ls-converter "-lFr" "-lFt" 'efs-alpha-converter)
|
|
|
5782
|
|
|
5783 (efs-add-ls-converter "-al" "-alt" 'efs-alpha-converter)
|
|
|
5784 (efs-add-ls-converter "-Al" "-Alt" 'efs-alpha-converter)
|
|
|
5785 (efs-add-ls-converter "-l" "-lt" 'efs-alpha-converter)
|
|
|
5786 (efs-add-ls-converter "-alF" "-alFt" 'efs-alpha-converter)
|
|
|
5787 (efs-add-ls-converter "-AlF" "-AlFt" 'efs-alpha-converter)
|
|
|
5788 (efs-add-ls-converter "-lF" "-lFt" 'efs-alpha-converter)
|
|
|
5789 (efs-add-ls-converter nil "-alt" 'efs-alpha-converter)
|
|
|
5790
|
|
|
5791 (efs-add-ls-converter "-alr" "-al" 'efs-ralpha-converter)
|
|
|
5792 (efs-add-ls-converter "-Alr" "-Al" 'efs-ralpha-converter)
|
|
|
5793 (efs-add-ls-converter "-lr" "-l" 'efs-ralpha-converter)
|
|
|
5794 (efs-add-ls-converter "-alFr" "-alF" 'efs-ralpha-converter)
|
|
|
5795 (efs-add-ls-converter "-lAFr" "-lAF" 'efs-ralpha-converter)
|
|
|
5796 (efs-add-ls-converter "-lFr" "-lF" 'efs-ralpha-converter)
|
|
|
5797 (efs-add-ls-converter "-alr" nil 'efs-ralpha-converter)
|
|
|
5798
|
|
|
5799 (efs-add-ls-converter "-alr" "-alt" 'efs-ralpha-converter)
|
|
|
5800 (efs-add-ls-converter "-Alr" "-Alt" 'efs-ralpha-converter)
|
|
|
5801 (efs-add-ls-converter "-lr" "-lt" 'efs-ralpha-converter)
|
|
|
5802 (efs-add-ls-converter "-alFr" "-alFt" 'efs-ralpha-converter)
|
|
|
5803 (efs-add-ls-converter "-lAFr" "-lAFt" 'efs-ralpha-converter)
|
|
|
5804 (efs-add-ls-converter "-lFr" "-lFt" 'efs-ralpha-converter)
|
|
|
5805
|
|
|
5806 (efs-add-ls-converter "-alS" "-al" 'efs-S-converter)
|
|
|
5807 (efs-add-ls-converter "-AlS" "-Al" 'efs-S-converter)
|
|
|
5808 (efs-add-ls-converter "-lS" "-l" 'efs-S-converter)
|
|
|
5809 (efs-add-ls-converter "-alSF" "-alF" 'efs-S-converter)
|
|
|
5810 (efs-add-ls-converter "-AlSF" "-AlF" 'efs-S-converter)
|
|
|
5811 (efs-add-ls-converter "-lSF" "-lF" 'efs-S-converter)
|
|
|
5812 (efs-add-ls-converter "-alS" nil 'efs-S-converter)
|
|
|
5813
|
|
|
5814 (efs-add-ls-converter "-alSr" "-al" 'efs-rS-converter)
|
|
|
5815 (efs-add-ls-converter "-AlSr" "-Al" 'efs-rS-converter)
|
|
|
5816 (efs-add-ls-converter "-lSr" "-l" 'efs-rS-converter)
|
|
|
5817 (efs-add-ls-converter "-alSFr" "-alF" 'efs-rS-converter)
|
|
|
5818 (efs-add-ls-converter "-AlSFr" "-AlF" 'efs-rS-converter)
|
|
|
5819 (efs-add-ls-converter "-lSFr" "-lF" 'efs-rS-converter)
|
|
|
5820 (efs-add-ls-converter "-alSr" nil 'efs-rS-converter)
|
|
|
5821
|
|
|
5822 (efs-add-ls-converter "-alS" "-alt" 'efs-S-converter)
|
|
|
5823 (efs-add-ls-converter "-AlS" "-Alt" 'efs-S-converter)
|
|
|
5824 (efs-add-ls-converter "-lS" "-lt" 'efs-S-converter)
|
|
|
5825 (efs-add-ls-converter "-alSF" "-alFt" 'efs-S-converter)
|
|
|
5826 (efs-add-ls-converter "-AlSF" "-AlFt" 'efs-S-converter)
|
|
|
5827 (efs-add-ls-converter "-lSF" "-lFt" 'efs-S-converter)
|
|
|
5828
|
|
|
5829 (efs-add-ls-converter "-alSr" "-alt" 'efs-rS-converter)
|
|
|
5830 (efs-add-ls-converter "-AlSr" "-Alt" 'efs-rS-converter)
|
|
|
5831 (efs-add-ls-converter "-lSr" "-lt" 'efs-rS-converter)
|
|
|
5832 (efs-add-ls-converter "-alSFr" "-alFt" 'efs-rS-converter)
|
|
|
5833 (efs-add-ls-converter "-AlSFr" "-AlFt" 'efs-rS-converter)
|
|
|
5834 (efs-add-ls-converter "-lSFr" "-lFt" 'efs-rS-converter)
|
|
|
5835
|
|
|
5836 (efs-add-ls-converter "-AlX" nil 'efs-X-converter)
|
|
|
5837 (efs-add-ls-converter "-alX" nil 'efs-X-converter)
|
|
|
5838 (efs-add-ls-converter "-AlXr" nil 'efs-rX-converter)
|
|
|
5839 (efs-add-ls-converter "-alXr" nil 'efs-rX-converter)
|
|
|
5840
|
|
|
5841 (efs-add-ls-converter "-alX" "-al" 'efs-X-converter)
|
|
|
5842 (efs-add-ls-converter "-AlX" "-Al" 'efs-X-converter)
|
|
|
5843 (efs-add-ls-converter "-lX" "-l" 'efs-X-converter)
|
|
|
5844 (efs-add-ls-converter "-alXF" "-alF" 'efs-X-converter)
|
|
|
5845 (efs-add-ls-converter "-AlXF" "-AlF" 'efs-X-converter)
|
|
|
5846 (efs-add-ls-converter "-lXF" "-lF" 'efs-X-converter)
|
|
|
5847
|
|
|
5848 (efs-add-ls-converter "-alXr" "-al" 'efs-rX-converter)
|
|
|
5849 (efs-add-ls-converter "-AlXr" "-Al" 'efs-rX-converter)
|
|
|
5850 (efs-add-ls-converter "-lXr" "-l" 'efs-rX-converter)
|
|
|
5851 (efs-add-ls-converter "-alXFr" "-alF" 'efs-rX-converter)
|
|
|
5852 (efs-add-ls-converter "-AlXFr" "-AlF" 'efs-rX-converter)
|
|
|
5853 (efs-add-ls-converter "-lXFr" "-lF" 'efs-rX-converter)
|
|
|
5854
|
|
|
5855 ;;; Converters for efs-files-hashtable
|
|
|
5856
|
|
|
5857 (efs-add-ls-converter
|
|
|
5858 "" t (function
|
|
|
5859 (lambda (host-type files &optional regexp)
|
|
|
5860 (efs-brief-converter host-type files
|
|
|
5861 nil nil nil nil nil nil regexp))))
|
|
|
5862 (efs-add-ls-converter
|
|
|
5863 "-C" t (function
|
|
|
5864 (lambda (host-type files &optional regexp)
|
|
|
5865 (efs-brief-converter host-type files
|
|
|
5866 nil nil nil nil nil t regexp))))
|
|
|
5867 (efs-add-ls-converter
|
|
|
5868 "-F" t (function
|
|
|
5869 (lambda (host-type files &optional regexp)
|
|
|
5870 (efs-brief-converter host-type files
|
|
|
5871 t nil nil nil nil nil regexp))))
|
|
|
5872 (efs-add-ls-converter
|
|
|
5873 "-p" t (function
|
|
|
5874 (lambda (host-type files &optional regexp)
|
|
|
5875 (efs-brief-converter host-type files
|
|
|
5876 nil nil nil t nil nil regexp))))
|
|
|
5877 (efs-add-ls-converter
|
|
|
5878 "-CF" t (function
|
|
|
5879 (lambda (host-type files &optional regexp)
|
|
|
5880 (efs-brief-converter host-type files
|
|
|
5881 t nil nil nil nil t regexp))))
|
|
|
5882 (efs-add-ls-converter
|
|
|
5883 "-Cp" t (function
|
|
|
5884 (lambda (host-type files &optional regexp)
|
|
|
5885 (efs-brief-converter host-type files nil nil nil t nil t regexp))))
|
|
|
5886 (efs-add-ls-converter
|
|
|
5887 "-x" t (function
|
|
|
5888 (lambda (host-type files &optional regexp)
|
|
|
5889 (efs-brief-converter host-type files
|
|
|
5890 nil nil nil nil t nil regexp))))
|
|
|
5891 (efs-add-ls-converter
|
|
|
5892 "-xF" t (function
|
|
|
5893 (lambda (host-type files &optional regexp)
|
|
|
5894 (efs-brief-converter host-type files t nil nil nil t nil regexp))))
|
|
|
5895 (efs-add-ls-converter
|
|
|
5896 "-xp" t (function
|
|
|
5897 (lambda (host-type files &optional regexp)
|
|
|
5898 (efs-brief-converter host-type files nil nil nil t t nil regexp))))
|
|
|
5899 (efs-add-ls-converter
|
|
|
5900 "-Ca" t (function
|
|
|
5901 (lambda (host-type files &optional regexp)
|
|
|
5902 (efs-brief-converter host-type files nil t nil nil nil t regexp))))
|
|
|
5903 (efs-add-ls-converter
|
|
|
5904 "-CFa" t (function
|
|
|
5905 (lambda (host-type files &optional regexp)
|
|
|
5906 (efs-brief-converter host-type files t t nil nil nil t regexp))))
|
|
|
5907 (efs-add-ls-converter
|
|
|
5908 "-Cpa" t (function
|
|
|
5909 (lambda (host-type files &optional regexp)
|
|
|
5910 (efs-brief-converter host-type files nil t nil t nil t regexp))))
|
|
|
5911 (efs-add-ls-converter
|
|
|
5912 "-xa" t (function
|
|
|
5913 (lambda (host-type files &optional regexp)
|
|
|
5914 (efs-brief-converter host-type files nil t nil nil t nil regexp))))
|
|
|
5915 (efs-add-ls-converter
|
|
|
5916 "-xFa" t (function
|
|
|
5917 (lambda (host-type files &optional regexp)
|
|
|
5918 (efs-brief-converter host-type files t t nil nil t nil regexp))))
|
|
|
5919 (efs-add-ls-converter
|
|
|
5920 "-xpa" t (function
|
|
|
5921 (lambda (host-type files &optional regexp)
|
|
|
5922 (efs-brief-converter host-type files nil t nil t t nil regexp))))
|
|
|
5923 (efs-add-ls-converter
|
|
|
5924 "-CA" t (function
|
|
|
5925 (lambda (host-type files &optional regexp)
|
|
|
5926 (efs-brief-converter host-type files nil nil t nil nil t regexp))))
|
|
|
5927 (efs-add-ls-converter
|
|
|
5928 "-CFA" t (function
|
|
|
5929 (lambda (host-type files &optional regexp)
|
|
|
5930 (efs-brief-converter host-type files t nil t nil nil t regexp))))
|
|
|
5931 (efs-add-ls-converter
|
|
|
5932 "-CpA" t (function
|
|
|
5933 (lambda (host-type files &optional regexp)
|
|
|
5934 (efs-brief-converter host-type files nil nil t t nil t regexp))))
|
|
|
5935 (efs-add-ls-converter
|
|
|
5936 "-xA" t (function
|
|
|
5937 (lambda (host-type files &optional regexp)
|
|
|
5938 (efs-brief-converter host-type files nil nil t nil t nil regexp))))
|
|
|
5939 (efs-add-ls-converter
|
|
|
5940 "-xFA" t (function
|
|
|
5941 (lambda (host-type files &optional regexp)
|
|
|
5942 (efs-brief-converter host-type files t nil t nil t nil regexp))))
|
|
|
5943 (efs-add-ls-converter
|
|
|
5944 "-xpA" t (function
|
|
|
5945 (lambda (host-type files &optional regexp)
|
|
|
5946 (efs-brief-converter host-type files nil nil t t t nil regexp))))
|
|
|
5947
|
|
|
5948 ;;;; ------------------------------------------------------------
|
|
|
5949 ;;;; Directory Listing Parsers
|
|
|
5950 ;;;; ------------------------------------------------------------
|
|
|
5951
|
|
|
5952 (defconst efs-unix:dl-listing-regexp
|
|
|
5953 "^[^ \n\t]+\n? +\\([0-9]+\\|-\\|=\\) ")
|
|
|
5954
|
|
|
5955 ;; Note to progammers:
|
|
|
5956 ;; Below are a series of macros and functions used for parsing unix
|
|
|
5957 ;; file listings. They are intended only to be used together, so be careful
|
|
|
5958 ;; about using them out of context.
|
|
|
5959
|
|
|
5960 (defmacro efs-ls-parse-file-line ()
|
|
|
5961 ;; Extract the filename, size, and permission string from the current
|
|
|
5962 ;; line of a dired-like listing. Assumes that the point is at
|
|
|
5963 ;; the beginning of the line, leaves it just before the size entry.
|
|
|
5964 ;; Returns a list (name size perm-string nlinks owner).
|
|
|
5965 ;; If there is no file on the line, returns nil.
|
|
|
5966 (` (let ((eol (save-excursion (end-of-line) (point)))
|
|
|
5967 name size modes nlinks owner)
|
|
|
5968 (skip-chars-forward " 0-9" eol)
|
|
|
5969 (and
|
|
|
5970 (looking-at efs-modes-links-owner-regexp)
|
|
|
5971 (setq modes (buffer-substring (match-beginning 1)
|
|
|
5972 (match-end 1))
|
|
|
5973 nlinks (string-to-int (buffer-substring (match-beginning 2)
|
|
|
5974 (match-end 2)))
|
|
|
5975 owner (buffer-substring (match-beginning 3) (match-end 3)))
|
|
|
5976 (re-search-forward efs-month-and-time-regexp eol t)
|
|
|
5977 (setq name (buffer-substring (point) eol)
|
|
|
5978 size (string-to-int (buffer-substring (match-beginning 1)
|
|
|
5979 (match-end 1))))
|
|
|
5980 (list name size modes nlinks owner)))))
|
|
|
5981
|
|
|
5982 (defun efs-relist-symlink (host user symlink path switches)
|
|
|
5983 ;; Does a re-list of a single symlink in efs-data-buffer-name-2,
|
|
|
5984 ;; HOST = remote host
|
|
|
5985 ;; USER = remote username
|
|
|
5986 ;; SYMLINK = symbolic link name as a remote fullpath
|
|
|
5987 ;; PATH = efs full path syntax for the dir. being listed
|
|
|
5988 ;; SWITCHES = ls switches to use for the re-list
|
|
|
5989 ;; Returns (symlink-name symlink-target), as given by the listing. Returns
|
|
|
5990 ;; nil if the listing fails.
|
|
|
5991 ;; Does NOT correct for any symlink marking.
|
|
|
5992 (let* ((temp (efs-make-tmp-name host nil))
|
|
|
5993 (temp-file (car temp))
|
|
|
5994 (default-major-mode 'fundamental-mode)
|
|
|
5995 spot)
|
|
|
5996 (unwind-protect
|
|
|
5997 (and
|
|
|
5998 (prog1
|
|
|
5999 (null
|
|
|
6000 (car
|
|
|
6001 (efs-send-cmd host user
|
|
|
6002 (list 'dir symlink (cdr temp) switches)
|
|
|
6003 (format "Listing %s"
|
|
|
6004 (efs-relativize-filename
|
|
|
6005 (efs-replace-path-component
|
|
|
6006 path symlink))))))
|
|
|
6007 ;; Put the old message back.
|
|
|
6008 (if (and efs-verbose
|
|
|
6009 (not (and (boundp 'dired-in-query) dired-in-query)))
|
|
|
6010 (message "Listing %s..."
|
|
|
6011 (efs-relativize-filename path))))
|
|
|
6012 (save-excursion
|
|
|
6013 (if (efs-ftp-path temp-file)
|
|
|
6014 (efs-add-file-entry (efs-host-type efs-gateway-host)
|
|
|
6015 temp-file nil nil nil))
|
|
|
6016 (set-buffer (get-buffer-create efs-data-buffer-name-2))
|
|
|
6017 (erase-buffer)
|
|
|
6018 (if (or (file-readable-p temp-file)
|
|
|
6019 (sleep-for efs-retry-time)
|
|
|
6020 (file-readable-p temp-file))
|
|
|
6021 (let (efs-verbose)
|
|
|
6022 (insert-file-contents temp-file))
|
|
|
6023 (efs-error host user
|
|
|
6024 (format
|
|
|
6025 "list data file %s not readable" temp-file)))
|
|
|
6026 (skip-chars-forward " 0-9")
|
|
|
6027 (and
|
|
|
6028 (eq (following-char) ?l)
|
|
|
6029 (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6030 (setq spot (point))
|
|
|
6031 (re-search-forward " -> " nil t)
|
|
|
6032 (progn
|
|
|
6033 (end-of-line)
|
|
|
6034 (list
|
|
|
6035 ;; We might get the full path in the listing.
|
|
|
6036 (file-name-nondirectory
|
|
|
6037 (buffer-substring spot (match-beginning 0)))
|
|
|
6038 (buffer-substring (match-end 0) (point)))))))
|
|
|
6039 (efs-del-tmp-name temp-file))))
|
|
|
6040
|
|
|
6041 (defun efs-ls-sysV-p (host user dir linkname path)
|
|
|
6042 ;; Returns t if the symlink is listed in sysV style. i.e. The
|
|
|
6043 ;; symlink name is marked with an @.
|
|
|
6044 ;; HOST = remote host name
|
|
|
6045 ;; USER = remote user name
|
|
|
6046 ;; DIR = directory being listed as a remote full path.
|
|
|
6047 ;; LINKNAME = relative name of symbolic link as derived from an ls -..F...
|
|
|
6048 ;; this is assumed to end with an @
|
|
|
6049 ;; PATH = efs full path synatx for the directory
|
|
|
6050 (let ((link (car (efs-relist-symlink
|
|
|
6051 host user
|
|
|
6052 (concat dir (substring linkname 0 -1))
|
|
|
6053 path "-lFd" ))))
|
|
|
6054 (and link (string-equal link linkname))))
|
|
|
6055
|
|
|
6056 (defun efs-ls-next-p (host user dir linkname target path)
|
|
|
6057 ;; Returns t is the symlink is marked in the NeXT style.
|
|
|
6058 ;; i.e. The symlink destination is marked with an @.
|
|
|
6059 ;; This assumes that the host-type has already been identified
|
|
|
6060 ;; as NOT sysV-unix, and that target ends in an "@".
|
|
|
6061 ;; HOST = remote host name
|
|
|
6062 ;; USER = remote user name
|
|
|
6063 ;; DIR = remote directory being listed, as a remore full path
|
|
|
6064 ;; LINKNAME = relative name of symbolic link
|
|
|
6065 ;; Since we've eliminated sysV, it won't be marked with an @
|
|
|
6066 ;; TARGET = target of symbolic link, as derived from an ls -..F..
|
|
|
6067 ;; PATH = directory being listed in full efs path syntax.
|
|
|
6068 (let ((no-F-target (nth 1 (efs-relist-symlink
|
|
|
6069 host user
|
|
|
6070 (concat dir linkname)
|
|
|
6071 path "-ld"))))
|
|
|
6072 (and no-F-target
|
|
|
6073 (string-equal (concat no-F-target "@") target))))
|
|
|
6074
|
|
|
6075 ;; This deals with the F switch. Should also do something about
|
|
|
6076 ;; unquoting names obtained with the SysV b switch and the GNU Q
|
|
|
6077 ;; switch. See Sebastian's dired-get-filename.
|
|
|
6078
|
|
|
6079 (defun efs-ls-parser (host-type host user dir path switches)
|
|
|
6080 ;; Meant to be called by efs-parse-listing.
|
|
|
6081 ;; Assumes that point is at the beginning of the first file line.
|
|
|
6082 ;; Assumes that SWITCHES has already been bound to nil for a dumb host.
|
|
|
6083 ;; HOST-TYPE is the remote host-type
|
|
|
6084 ;; HOST is the remote host name
|
|
|
6085 ;; USER is the remote user name
|
|
|
6086 ;; DIR is the remote directory as a full path
|
|
|
6087 ;; PATH is the directory in full efs syntax, and directory syntax.
|
|
|
6088 ;; SWITCHES is the ls listing switches
|
|
|
6089 (let ((tbl (efs-make-hashtable))
|
|
|
6090 (used-F (and switches (string-match "F" switches)))
|
|
|
6091 (old-tbl (efs-get-files-hashtable-entry path))
|
|
|
6092 file-type symlink directory file size modes nlinks owner)
|
|
|
6093 (while (setq file (efs-ls-parse-file-line))
|
|
|
6094 (setq size (nth 1 file)
|
|
|
6095 modes (nth 2 file)
|
|
|
6096 nlinks (nth 3 file)
|
|
|
6097 owner (nth 4 file)
|
|
|
6098 file (car file)
|
|
|
6099 file-type (string-to-char modes)
|
|
|
6100 directory (eq file-type ?d))
|
|
|
6101 (if (eq file-type ?l)
|
|
|
6102 (if (string-match " -> " file)
|
|
|
6103 (setq symlink (substring file (match-end 0))
|
|
|
6104 file (substring file 0 (match-beginning 0)))
|
|
|
6105 ;; Shouldn't happen
|
|
|
6106 (setq symlink ""))
|
|
|
6107 (setq symlink nil))
|
|
|
6108 (if used-F
|
|
|
6109 ;; The F-switch jungle
|
|
|
6110 (let ((socket (eq file-type ?s))
|
|
|
6111 (fifo (eq file-type ?p))
|
|
|
6112 (executable
|
|
|
6113 (and (not symlink) ; x bits don't mean a thing for symlinks
|
|
|
6114 (or (memq (elt modes 3) '(?x ?s ?t))
|
|
|
6115 (memq (elt modes 6) '(?x ?s ?t))
|
|
|
6116 (memq (elt modes 9) '(?x ?s ?t))))))
|
|
|
6117 ;; Deal with marking of directories, executables, and sockets.
|
|
|
6118 (if (or (and executable (string-match "*$" file))
|
|
|
6119 (and socket (string-match "=$" file))
|
|
|
6120 (and fifo (string-match "|$" file)))
|
|
|
6121 (setq file (substring file 0 -1))
|
|
|
6122 ;; Do the symlink dance.
|
|
|
6123 (if symlink
|
|
|
6124 (let ((fat-p (string-match "@$" file))
|
|
|
6125 (sat-p (string-match "@$" symlink)))
|
|
|
6126 (cond
|
|
|
6127 ;; Those that mark the file
|
|
|
6128 ((and (memq host-type '(sysV-unix apollo-unix)) fat-p)
|
|
|
6129 (setq file (substring file 0 -1)))
|
|
|
6130 ;; Those that mark nothing
|
|
|
6131 ((memq host-type '(bsd-unix dumb-unix)))
|
|
|
6132 ;; Those that mark the target
|
|
|
6133 ((and (eq host-type 'next-unix) sat-p)
|
|
|
6134 (setq symlink (substring symlink 0 -1)))
|
|
|
6135 ;; We don't know
|
|
|
6136 ((eq host-type 'unix)
|
|
|
6137 (if fat-p
|
|
|
6138 (cond
|
|
|
6139 ((efs-ls-sysV-p host user dir
|
|
|
6140 file path)
|
|
|
6141 (setq host-type 'sysV-unix
|
|
|
6142 file (substring file 0 -1))
|
|
|
6143 (efs-add-host 'sysV-unix host)
|
|
|
6144 (efs-add-listing-type 'sysV-unix host user))
|
|
|
6145 ((and sat-p
|
|
|
6146 (efs-ls-next-p host user dir file symlink
|
|
|
6147 path))
|
|
|
6148 (setq host-type 'next-unix
|
|
|
6149 symlink (substring symlink 0 -1))
|
|
|
6150 (efs-add-host 'next-unix host)
|
|
|
6151 (efs-add-listing-type 'next-unix host user))
|
|
|
6152 (t
|
|
|
6153 (setq host-type 'bsd-unix)
|
|
|
6154 (efs-add-host 'bsd-unix host)
|
|
|
6155 (efs-add-listing-type 'bsd-unix host user)))
|
|
|
6156 (if (and sat-p
|
|
|
6157 (efs-ls-next-p host user dir file
|
|
|
6158 symlink path))
|
|
|
6159 (progn
|
|
|
6160 (setq host-type 'next-unix
|
|
|
6161 symlink (substring symlink 0 -1))
|
|
|
6162 (efs-add-host 'next-unix host)
|
|
|
6163 (efs-add-listing-type 'next-unix host user))
|
|
|
6164 (setq host-type 'bsd-unix)
|
|
|
6165 (efs-add-host 'bsd-unix host)
|
|
|
6166 (efs-add-listing-type 'bsd-unix host user)))))
|
|
|
6167 ;; Look out for marking of symlink
|
|
|
6168 ;; If we really wanted to, at this point we
|
|
|
6169 ;; could distinguish aix from hp-ux, ultrix, irix and a/ux,
|
|
|
6170 ;; allowing us to skip the re-list in the future, for the
|
|
|
6171 ;; later 4 host types. Another version...
|
|
|
6172 (if (string-match "[=|*]$" symlink)
|
|
|
6173 (let ((relist (efs-relist-symlink
|
|
|
6174 host user (concat dir file)
|
|
|
6175 path "-dl")))
|
|
|
6176 (if relist (setq symlink (nth 1 relist))))))))))
|
|
|
6177 ;; Strip / off the end unconditionally. It's not a valid file character
|
|
|
6178 ;; anyway.
|
|
|
6179 (if (string-match "/$" file) (setq file (substring file 0 -1)))
|
|
|
6180 (let ((mdtm (and old-tbl (nth 5 (efs-get-hash-entry file old-tbl)))))
|
|
|
6181 (if mdtm
|
|
|
6182 (efs-put-hash-entry file (list (or symlink directory) size owner
|
|
|
6183 modes nlinks mdtm) tbl)
|
|
|
6184 (efs-put-hash-entry file (list (or symlink directory) size owner
|
|
|
6185 modes nlinks) tbl)))
|
|
|
6186 (forward-line 1))
|
|
|
6187 (efs-put-hash-entry "." '(t) tbl)
|
|
|
6188 (efs-put-hash-entry ".." '(t) tbl)
|
|
|
6189 tbl))
|
|
|
6190
|
|
|
6191 (efs-defun efs-parse-listing nil (host user dir path &optional switches)
|
|
|
6192 ;; Parse the a listing which is assumed to be from some type of unix host.
|
|
|
6193 ;; Note that efs-key will be bound to the actual host type.
|
|
|
6194 ;; HOST = remote host name
|
|
|
6195 ;; USER = remote user name
|
|
|
6196 ;; DIR = directory as a remote full path
|
|
|
6197 ;; PATH = directory in full efs path syntax
|
|
|
6198 ;; SWITCHES = ls switches used for the listing
|
|
|
6199 (efs-save-match-data
|
|
|
6200 (cond
|
|
|
6201 ;; look for total line
|
|
|
6202 ((looking-at "^total [0-9]+$")
|
|
|
6203 (forward-line 1)
|
|
|
6204 ;; Beware of machines that put a blank line after the totals line.
|
|
|
6205 (skip-chars-forward " \t\n")
|
|
|
6206 (efs-ls-parser efs-key host user dir path switches))
|
|
|
6207 ;; look for errors
|
|
|
6208 ((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
|
|
|
6209 ;; It's an ls error message.
|
|
|
6210 nil)
|
|
|
6211 ((eobp) ; i.e. zerop buffer-size
|
|
|
6212 nil) ; assume an ls error message
|
|
|
6213 ;; look for listings without total lines
|
|
|
6214 ((re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6215 (beginning-of-line)
|
|
|
6216 (efs-ls-parser efs-key host user dir path switches))
|
|
|
6217 (t nil))))
|
|
|
6218
|
|
|
6219 (efs-defun efs-parse-listing unix:unknown
|
|
|
6220 (host user dir path &optional switches)
|
|
|
6221 ;; Parse the a listing which is assumed to be from some type of unix host,
|
|
|
6222 ;; possibly one doing a dl listing.
|
|
|
6223 ;; HOST = remote host name
|
|
|
6224 ;; USER = remote user name
|
|
|
6225 ;; DIR = directory as a remote full path
|
|
|
6226 ;; PATH = directory in full efs path syntax
|
|
|
6227 ;; SWITCHES = ls switches used for the listing
|
|
|
6228 (efs-save-match-data
|
|
|
6229 (cond
|
|
|
6230 ;; look for total line
|
|
|
6231 ((looking-at "^total [0-9]+$")
|
|
|
6232 (forward-line 1)
|
|
|
6233 ;; Beware of machines that put a blank line after the totals line.
|
|
|
6234 (skip-chars-forward " \t\n")
|
|
|
6235 ;; This will make the listing-type track the host-type.
|
|
|
6236 (efs-add-listing-type nil host user)
|
|
|
6237 (efs-ls-parser 'unix host user dir path switches))
|
|
|
6238 ;; look for errors
|
|
|
6239 ((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
|
|
|
6240 ;; It's an ls error message.
|
|
|
6241 nil)
|
|
|
6242 ((eobp) ; i.e. zerop buffer-size
|
|
|
6243 nil) ; assume an ls error message
|
|
|
6244 ;; look for listings without total lines
|
|
|
6245 ((and (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6246 (progn
|
|
|
6247 (beginning-of-line)
|
|
|
6248 (looking-at efs-modes-links-owner-regexp)))
|
|
|
6249 (efs-add-listing-type nil host user)
|
|
|
6250 (efs-ls-parser 'unix host user dir path switches))
|
|
|
6251 ;; look for dumb listings
|
|
|
6252 ((re-search-forward
|
|
|
6253 (concat (regexp-quote switches)
|
|
|
6254 " not found\\|\\(^ls: +illegal option -- \\)")
|
|
|
6255 (save-excursion (end-of-line) (point)) t)
|
|
|
6256 (if (eq (efs-host-type host) 'apollo-unix)
|
|
|
6257 (progn
|
|
|
6258 (efs-add-host 'dumb-apollo-unix host)
|
|
|
6259 (efs-add-listing-type 'dumb-apollo-unix host user))
|
|
|
6260 (efs-add-host 'dumb-unix host)
|
|
|
6261 (efs-add-listing-type 'dumb-unix host user))
|
|
|
6262 (if (match-beginning 1)
|
|
|
6263 ;; Need to try to list again.
|
|
|
6264 (let ((efs-ls-uncache t))
|
|
|
6265 (efs-ls
|
|
|
6266 path nil (format "Relisting %s" (efs-relativize-filename path)) t)
|
|
|
6267 (goto-char (point-min))
|
|
|
6268 (efs-parse-listing nil host user dir path switches))
|
|
|
6269 (if (re-search-forward "^total [0-9]+$" nil t)
|
|
|
6270 (progn
|
|
|
6271 (beginning-of-line)
|
|
|
6272 (delete-region (point-min) (point))
|
|
|
6273 (forward-line 1)
|
|
|
6274 (efs-ls-parser 'dumb-unix host user dir path switches)))))
|
|
|
6275 ;; Look for dl listings.
|
|
|
6276 ((re-search-forward efs-unix:dl-listing-regexp nil t)
|
|
|
6277 (efs-add-host 'unix host)
|
|
|
6278 (efs-add-listing-type 'unix:dl host user)
|
|
|
6279 (efs-parse-listing 'unix:dl host user dir path switches))
|
|
|
6280 ;; don't know, return nil
|
|
|
6281 (t nil))))
|
|
|
6282
|
|
|
6283 (defun efs-ls-parse-1-liner (filename buffer &optional symlink)
|
|
|
6284 ;; Parse a 1-line listing for FILENAME in BUFFER, and update
|
|
|
6285 ;; the cached info for FILENAME.
|
|
|
6286 ;; Optional SYMLINK arg gives the expected target of a symlink.
|
|
|
6287 ;; Since one-line listings are usually used to update info for
|
|
|
6288 ;; newly created files, we usually know what sort of a file to expect.
|
|
|
6289 ;; Actually trying to parse out the symlink target could be impossible
|
|
|
6290 ;; for some types of switches.
|
|
|
6291 (efs-save-buffer-excursion
|
|
|
6292 (set-buffer buffer)
|
|
|
6293 (goto-char (point-min))
|
|
|
6294 (skip-chars-forward " 0-9")
|
|
|
6295 (efs-save-match-data
|
|
|
6296 (let (modes nlinks owner size)
|
|
|
6297 (and
|
|
|
6298 (looking-at efs-modes-links-owner-regexp)
|
|
|
6299 (setq modes (buffer-substring (match-beginning 1) (match-end 1))
|
|
|
6300 nlinks (string-to-int (buffer-substring (match-beginning 2)
|
|
|
6301 (match-end 2)))
|
|
|
6302 owner (buffer-substring (match-beginning 3) (match-end 3)))
|
|
|
6303 (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6304 (setq size (string-to-int (buffer-substring (match-beginning 1)
|
|
|
6305 (match-end 1))))
|
|
|
6306 (let* ((filename (directory-file-name filename))
|
|
|
6307 (files (efs-get-files-hashtable-entry
|
|
|
6308 (file-name-directory filename))))
|
|
|
6309 (if files
|
|
|
6310 (let* ((key (efs-get-file-part filename))
|
|
|
6311 (ignore-case (memq (efs-host-type
|
|
|
6312 (car (efs-ftp-path filename)))
|
|
|
6313 efs-case-insensitive-host-types))
|
|
|
6314 (ent (efs-get-hash-entry key files ignore-case))
|
|
|
6315 (mdtm (nth 5 ent))
|
|
|
6316 type)
|
|
|
6317 (if (= (string-to-char modes) ?l)
|
|
|
6318 (setq type
|
|
|
6319 (cond
|
|
|
6320 ((stringp symlink)
|
|
|
6321 symlink)
|
|
|
6322 ((stringp (car ent))
|
|
|
6323 (car ent))
|
|
|
6324 (t ; something weird happened.
|
|
|
6325 "")))
|
|
|
6326 (if (= (string-to-char modes) ?d)
|
|
|
6327 (setq type t)))
|
|
|
6328 (efs-put-hash-entry
|
|
|
6329 key (list type size owner modes nlinks mdtm)
|
|
|
6330 files ignore-case)))))))))
|
|
|
6331
|
|
|
6332 (efs-defun efs-update-file-info nil (file buffer &optional symlink)
|
|
|
6333 "For FILE, update cache information from a single file listing in BUFFER."
|
|
|
6334 ;; By default, this does nothing.
|
|
|
6335 nil)
|
|
|
6336
|
|
|
6337 (efs-defun efs-update-file-info unix (file buffer &optional symlink)
|
|
|
6338 (efs-ls-parse-1-liner file buffer))
|
|
|
6339 (efs-defun efs-update-file-info sysV-unix (file buffer &optional symlink)
|
|
|
6340 (efs-ls-parse-1-liner file buffer))
|
|
|
6341 (efs-defun efs-update-file-info bsd-unix (file buffer &optional symlink)
|
|
|
6342 (efs-ls-parse-1-liner file buffer))
|
|
|
6343 (efs-defun efs-update-file-info next-unix (file buffer &optional symlink)
|
|
|
6344 (efs-ls-parse-1-liner file buffer))
|
|
|
6345 (efs-defun efs-update-file-info apollo-unix (file buffer &optional symlink)
|
|
|
6346 (efs-ls-parse-1-liner file buffer))
|
|
|
6347 (efs-defun efs-update-file-info dumb-unix (file buffer &optional symlink)
|
|
|
6348 (efs-ls-parse-1-liner file buffer))
|
|
|
6349 (efs-defun efs-update-file-info dumb-apollo-unix
|
|
|
6350 (file buffer &optional symlink)
|
|
|
6351 (efs-ls-parse-1-liner file buffer))
|
|
|
6352 (efs-defun efs-update-file-info super-dumb-unix (file buffer &optional symlink)
|
|
|
6353 (efs-ls-parse-1-liner file buffer))
|
|
|
6354
|
|
|
6355 ;;;; ----------------------------------------------------------------
|
|
|
6356 ;;;; The 'unknown listing parser. This does some host-type guessing.
|
|
|
6357 ;;;; ----------------------------------------------------------------
|
|
|
6358
|
|
|
6359 ;;; Regexps for host and listing type guessing from the listing syntax.
|
|
|
6360
|
|
|
6361 (defconst efs-ka9q-listing-regexp
|
|
|
6362 (concat
|
|
|
6363 "^\\([0-9,.]+\\|No\\) files\\. [0-9,.]+ bytes free\\. "
|
|
|
6364 "Disk size [0-9,]+ bytes\\.$"))
|
|
|
6365 ;; This version of the regexp is really for hosts which allow some switches,
|
|
|
6366 ;; but not ours. Rather than determine which switches we could be using
|
|
|
6367 ;; we just assume that it's dumb.
|
|
|
6368 (defconst efs-dumb-unix-listing-regexp
|
|
|
6369 (concat
|
|
|
6370 "^[Uu]sage: +ls +-[a-zA-Z0-9]+[ \n]\\|"
|
|
|
6371 ;; Unitree server
|
|
|
6372 "^Error getting stats for \"-[a-zA-Z0-9]+\""))
|
|
|
6373
|
|
|
6374 (defconst efs-dos-distinct-date-and-time-regexp
|
|
|
6375 (concat
|
|
|
6376 " \\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct"
|
|
|
6377 "\\|Nov\\|Dec\\) [ 0-3][0-9],[12][90][0-9][0-9] "
|
|
|
6378 "[ 12][0-9]:[0-5][0-9] "))
|
|
|
6379 ;; Regexp to match the output from the hellsoft ftp server to an
|
|
|
6380 ;; ls -al. Unfortunately, this looks a lot like some unix ls error
|
|
|
6381 ;; messages.
|
|
|
6382 (defconst efs-hell-listing-regexp
|
|
|
6383 (concat
|
|
|
6384 "ls: file or directory not found\n\\'\\|"
|
|
|
6385 "[-d]\\[[-A-Z][-A-Z][-A-Z][-A-Z][-A-Z][-A-Z][-A-Z]\\]"))
|
|
|
6386
|
|
|
6387 (efs-defun efs-parse-listing unknown
|
|
|
6388 (host user dir path &optional switches)
|
|
|
6389 "Parse the current buffer which is assumed to contain a dir listing.
|
|
|
6390 Return a hashtable as the result. If the listing is not really a
|
|
|
6391 directory listing, then return nil.
|
|
|
6392
|
|
|
6393 HOST is the remote host's name.
|
|
|
6394 USER is the remote user name.
|
|
|
6395 DIR is the directory as a full remote path.
|
|
|
6396 PATH is the directory in full efs path synatx.
|
|
|
6397 SWITCHES are the switches passed to ls. If SWITCHES is nil, then a
|
|
|
6398 dumb \(with dir\) listing has been done."
|
|
|
6399 (efs-save-match-data
|
|
|
6400 (cond
|
|
|
6401
|
|
|
6402 ;; look for total line
|
|
|
6403 ((looking-at "^total [0-9]+$")
|
|
|
6404 (efs-add-host 'unix host)
|
|
|
6405 (forward-line 1)
|
|
|
6406 ;; Beware of machines that put a blank line after the totals line.
|
|
|
6407 (skip-chars-forward " \t\n")
|
|
|
6408 (efs-ls-parser 'unix host user dir path switches))
|
|
|
6409
|
|
|
6410 ;; Look for hellsoft. Need to do this before looking
|
|
|
6411 ;; for ls errors, since the hellsoft output looks a lot like an ls error.
|
|
|
6412 ((looking-at efs-hell-listing-regexp)
|
|
|
6413 (if (null (car (efs-send-cmd host user '(quote site dos))))
|
|
|
6414 (let* ((key (concat host "/" user "/~"))
|
|
|
6415 (tilde (efs-get-hash-entry
|
|
|
6416 key efs-expand-dir-hashtable)))
|
|
|
6417 (efs-add-host 'hell host)
|
|
|
6418 ;; downcase the expansion of ~
|
|
|
6419 (if (and tilde (string-match "^[^a-z]+$" tilde))
|
|
|
6420 (efs-put-hash-entry key (downcase tilde)
|
|
|
6421 efs-expand-dir-hashtable))
|
|
|
6422 ;; Downcase dir, in case its got some upper case stuff in it.
|
|
|
6423 (setq dir (downcase dir)
|
|
|
6424 path (efs-replace-path-component path dir))
|
|
|
6425 (let ((efs-ls-uncache t))
|
|
|
6426 ;; This will force the data buffer to be re-filled
|
|
|
6427 (efs-ls path nil (format "Relisting %s"
|
|
|
6428 (efs-relativize-filename path))
|
|
|
6429 t))
|
|
|
6430 (efs-parse-listing 'hell host user dir path))
|
|
|
6431 ;; Don't know, give unix a try.
|
|
|
6432 (efs-add-host 'unix host)
|
|
|
6433 nil))
|
|
|
6434
|
|
|
6435 ;; look for ls errors
|
|
|
6436 ((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
|
|
|
6437 ;; It's an ls error message.
|
|
|
6438 (efs-add-host 'unix host)
|
|
|
6439 nil)
|
|
|
6440
|
|
|
6441 ((eobp) ; i.e. (zerop (buffer-size))
|
|
|
6442 ;; This could be one of:
|
|
|
6443 ;; (1) An Ultrix ls error message
|
|
|
6444 ;; (2) A listing with the A switch of an empty directory
|
|
|
6445 ;; on a machine which doesn't give a total line.
|
|
|
6446 ;; (3) The result of an attempt at an nlist. (This would mean a
|
|
|
6447 ;; dumb host.)
|
|
|
6448 ;; (4) The twilight zone.
|
|
|
6449 (cond
|
|
|
6450 ((save-excursion
|
|
|
6451 (set-buffer (process-buffer
|
|
|
6452 (efs-get-process host user)))
|
|
|
6453 (save-excursion
|
|
|
6454 (goto-char (point-max))
|
|
|
6455 (and
|
|
|
6456 ;; The dir ftp output starts with a 200 cmd.
|
|
|
6457 (re-search-backward "^150 " nil t)
|
|
|
6458 ;; We never do an nlist (it's a short listing).
|
|
|
6459 ;; If the machine thinks that we did, it's dumb.
|
|
|
6460 (looking-at "[^\n]+ NLST "))))
|
|
|
6461 ;; It's dumb-unix or ka9q. Anything else?
|
|
|
6462 ;; This will re-fill the data buffer with a dumb listing.
|
|
|
6463 (let ((efs-ls-uncache t))
|
|
|
6464 (efs-ls path nil (format "Relisting %s"
|
|
|
6465 (efs-relativize-filename path))
|
|
|
6466 t))
|
|
|
6467 (cond
|
|
|
6468 ;; check for dumb-unix
|
|
|
6469 ((re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6470 (efs-add-host 'dumb-unix host)
|
|
|
6471 (beginning-of-line)
|
|
|
6472 (efs-parse-listing 'dumb-unix host user dir path))
|
|
|
6473 ;; check for ka9q
|
|
|
6474 ((save-excursion
|
|
|
6475 (goto-char (point-max))
|
|
|
6476 (forward-line -1)
|
|
|
6477 (looking-at efs-ka9q-listing-regexp))
|
|
|
6478 (efs-add-host 'ka9q host)
|
|
|
6479 (efs-parse-listing 'ka9q host user dir path))
|
|
|
6480 (t ; Don't know, try unix.
|
|
|
6481 (efs-add-host 'unix host)
|
|
|
6482 nil)))
|
|
|
6483 ;; check for Novell Netware
|
|
|
6484 ((null (car (efs-send-cmd host user '(quote site nfs))))
|
|
|
6485 (efs-add-host 'netware host)
|
|
|
6486 (let ((efs-ls-uncache t))
|
|
|
6487 (efs-ls path nil (format "Relisting %s"
|
|
|
6488 (efs-relativize-filename path))
|
|
|
6489 t))
|
|
|
6490 (efs-parse-listing 'netware host user dir path))
|
|
|
6491 (t
|
|
|
6492 ;; Assume (1), an Ultrix error message.
|
|
|
6493 (efs-add-host 'unix host)
|
|
|
6494 nil)))
|
|
|
6495
|
|
|
6496 ;; unix without a total line
|
|
|
6497 ((re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6498 (efs-add-host 'unix host)
|
|
|
6499 (beginning-of-line)
|
|
|
6500 (efs-ls-parser 'unix host user dir path switches))
|
|
|
6501
|
|
|
6502 ;; Now we look for host-types, or listing-types which are auto-rec
|
|
|
6503 ;; by the listing parser, because it's not possible to pick them out
|
|
|
6504 ;; from a pwd.
|
|
|
6505
|
|
|
6506 ;; check for dumb-unix
|
|
|
6507 ;; (Guessing of dumb-unix hosts which return an ftp error message is
|
|
|
6508 ;; done in efs-ls.)
|
|
|
6509 ((re-search-forward efs-dumb-unix-listing-regexp nil t)
|
|
|
6510 (efs-add-host 'dumb-unix host)
|
|
|
6511 ;; This will force the data buffer to be re-filled
|
|
|
6512 (let ((efs-ls-uncache t))
|
|
|
6513 (efs-ls path nil (format "Relisting %s"
|
|
|
6514 (efs-relativize-filename path))
|
|
|
6515 t))
|
|
|
6516 (efs-parse-listing 'dumb-unix host user dir path))
|
|
|
6517
|
|
|
6518 ;; check for Distinct's DOS ftp server
|
|
|
6519 ((re-search-forward efs-dos-distinct-date-and-time-regexp nil t)
|
|
|
6520 (efs-add-host 'dos-distinct host)
|
|
|
6521 (efs-parse-listing 'dos-distinct host user dir path))
|
|
|
6522
|
|
|
6523 ;; check for KA9Q pseudo-unix (LINUX?)
|
|
|
6524 ((save-excursion
|
|
|
6525 (goto-char (point-max))
|
|
|
6526 (forward-line -1)
|
|
|
6527 (looking-at efs-ka9q-listing-regexp))
|
|
|
6528 (efs-add-host 'ka9q host)
|
|
|
6529 ;; This will re-fill the data buffer.
|
|
|
6530 ;; Need to do this because ka9q is a dumb host.
|
|
|
6531 (let ((efs-ls-uncache t))
|
|
|
6532 (efs-ls path nil (format "Relisting %s"
|
|
|
6533 (efs-relativize-filename path))
|
|
|
6534 t))
|
|
|
6535 (efs-parse-listing 'ka9q host user dir path))
|
|
|
6536
|
|
|
6537 ;; Check for a unix descriptive (dl) listing
|
|
|
6538 ;; Do this last, because it's hard to guess.
|
|
|
6539 ((re-search-forward efs-unix:dl-listing-regexp nil t)
|
|
|
6540 (efs-add-host 'unix host)
|
|
|
6541 (efs-add-listing-type 'unix:dl host user)
|
|
|
6542 (efs-parse-listing 'unix:dl host user dir path switches))
|
|
|
6543
|
|
|
6544 ;; Don't know what's going on. Return nil, and assume unix.
|
|
|
6545 (t
|
|
|
6546 (efs-add-host 'unix host)
|
|
|
6547 nil))))
|
|
|
6548
|
|
|
6549 ;;;; ------------------------------------------------------------
|
|
|
6550 ;;;; Directory information hashtable.
|
|
|
6551 ;;;; ------------------------------------------------------------
|
|
|
6552
|
|
|
6553 (efs-defun efs-really-file-p nil (file ent)
|
|
|
6554 ;; efs-files-hashtable sometimes contains fictitious entries, when
|
|
|
6555 ;; some OS's allow a file to be accessed by another name. For example,
|
|
|
6556 ;; in VMS the highest version of a file may be accessed by omitting the
|
|
|
6557 ;; the file version number. This function should return t if the
|
|
|
6558 ;; filename FILE is really a file. ENT is the hash entry of the file.
|
|
|
6559 t)
|
|
|
6560
|
|
|
6561 (efs-defun efs-add-file-entry nil (path type size owner
|
|
|
6562 &optional modes nlinks mdtm)
|
|
|
6563 ;; Add a new file entry for PATH
|
|
|
6564 ;; TYPE is nil for a plain file, t for a directory, and a string
|
|
|
6565 ;; (the target of the link) for a symlink.
|
|
|
6566 ;; SIZE is the size of the file in bytes.
|
|
|
6567 ;; OWNER is the owner of the file, as a string.
|
|
|
6568 ;; MODES is the file modes, as a string. In Unix, this will be 10 cars.
|
|
|
6569 ;; NLINKS is the number of links for the file.
|
|
|
6570 ;; MDTM is the last modtime obtained for the file. This is for
|
|
|
6571 ;; short-term cache only, as emacs often has sequences of functions
|
|
|
6572 ;; doing modtime lookup. If you really want to be sure of the modtime,
|
|
|
6573 ;; use efs-get-file-mdtm, which asks the remote server.
|
|
|
6574
|
|
|
6575 (and (eq type t)
|
|
|
6576 (setq path (directory-file-name path)))
|
|
|
6577 (let ((files (efs-get-files-hashtable-entry (file-name-directory path))))
|
|
|
6578 (if files
|
|
|
6579 (efs-put-hash-entry
|
|
|
6580 (efs-get-file-part path)
|
|
|
6581 (cond (mdtm
|
|
|
6582 (list type size owner modes nlinks
|
|
|
6583 mdtm))
|
|
|
6584 (nlinks
|
|
|
6585 (list type size owner modes nlinks))
|
|
|
6586 (modes (list type size owner modes))
|
|
|
6587 (t (list type size owner)))
|
|
|
6588 files
|
|
|
6589 (memq efs-key efs-case-insensitive-host-types)))
|
|
|
6590 (efs-del-from-ls-cache path t nil)))
|
|
|
6591
|
|
|
6592 (efs-defun efs-delete-file-entry nil (path &optional dir-p)
|
|
|
6593 "Delete the file entry for PATH, if its directory info exists."
|
|
|
6594 (if dir-p
|
|
|
6595 (progn
|
|
|
6596 (setq path (file-name-as-directory path))
|
|
|
6597 (efs-del-hash-entry (efs-canonize-file-name path)
|
|
|
6598 efs-files-hashtable)
|
|
|
6599 ;; Note that file-name-as-directory followed by
|
|
|
6600 ;; (substring path 0 -1)
|
|
|
6601 ;; serves to canonicalize directory file names to their unix form.
|
|
|
6602 ;; i.e. in VMS, FOO.DIR -> FOO/ -> FOO
|
|
|
6603 ;; PATH is supposed to be s fully expanded efs-style path.
|
|
|
6604 (setq path (substring path 0 -1))))
|
|
|
6605 (let ((files (efs-get-files-hashtable-entry (file-name-directory path))))
|
|
|
6606 (if files
|
|
|
6607 (efs-del-hash-entry
|
|
|
6608 (efs-get-file-part path)
|
|
|
6609 files
|
|
|
6610 (memq (efs-host-type (car (efs-ftp-path path)))
|
|
|
6611 efs-case-insensitive-host-types))))
|
|
|
6612 (efs-del-from-ls-cache path t nil)
|
|
|
6613 (if dir-p (efs-del-from-ls-cache path nil t)))
|
|
|
6614
|
|
|
6615 (defun efs-set-files (directory files)
|
|
|
6616 "For DIRECTORY, set or change the associated FILES hashtable."
|
|
|
6617 (if files
|
|
|
6618 (efs-put-hash-entry
|
|
|
6619 (efs-canonize-file-name (file-name-as-directory directory))
|
|
|
6620 files efs-files-hashtable)))
|
|
|
6621
|
|
|
6622 (defun efs-parsable-switches-p (switches &optional full-dir)
|
|
|
6623 ;; Returns non-nil if SWITCHES would give an ls listing suitable for parsing
|
|
|
6624 ;; If FULL-DIR is non-nil, the switches must be suitable for parsing a full
|
|
|
6625 ;; ditectory.
|
|
|
6626 (or (null switches)
|
|
|
6627 (efs-save-match-data
|
|
|
6628 (and (string-match "[aA]" switches)
|
|
|
6629 ;; g is not good enough, need l or o for owner.
|
|
|
6630 (string-match "[lo]" switches)
|
|
|
6631 ;; L shows link target, rather than link. We need both.
|
|
|
6632 (not (string-match "[RfL]" switches))
|
|
|
6633 (not (and full-dir (string-match "d" switches)))))))
|
|
|
6634
|
|
|
6635 (defun efs-get-files (directory &optional no-error)
|
|
|
6636 "For DIRECTORY, return a hashtable of file entries.
|
|
|
6637 This will give an error or return nil, depending on the value of
|
|
|
6638 NO-ERROR, if a listing for DIRECTORY cannot be obtained."
|
|
|
6639 (let ((directory (file-name-as-directory directory)))
|
|
|
6640 (or (efs-get-files-hashtable-entry directory)
|
|
|
6641 (and (efs-ls directory (efs-ls-guess-switches) t 'parse no-error)
|
|
|
6642 (efs-get-files-hashtable-entry directory)))))
|
|
|
6643
|
|
|
6644 (efs-defun efs-allow-child-lookup nil (host user dir file)
|
|
|
6645 ;; Returns non-nil if in directory DIR, FILE could possibly be a subdir
|
|
|
6646 ;; according to its file-name syntax, and therefore a child listing should
|
|
|
6647 ;; be attempted. Note that DIR is in directory syntax.
|
|
|
6648 ;; i.e. /foo/bar/, not /foo/bar.
|
|
|
6649 ;; Deal with dired. Anything else?
|
|
|
6650 (not (and (boundp 'dired-local-variables-file)
|
|
|
6651 (stringp dired-local-variables-file)
|
|
|
6652 (string-equal dired-local-variables-file file))))
|
|
|
6653
|
|
|
6654 (defmacro efs-ancestral-check (host-type path ignore-case)
|
|
|
6655 ;; Checks to see if something in a path's ancient parentage
|
|
|
6656 ;; would make it impossible for the path to exist in the directory
|
|
|
6657 ;; tree. In this case it returns nil. Otherwise returns t (there
|
|
|
6658 ;; is essentially no information returned in this case, the file
|
|
|
6659 ;; may exist or not).
|
|
|
6660 ;; This macro should make working with RCS more efficient.
|
|
|
6661 ;; It also helps with FTP servers that go into fits if we ask to
|
|
|
6662 ;; list a non-existent dir.
|
|
|
6663 ;; Yes, I know that the function mapped over the hashtable can
|
|
|
6664 ;; be written more cleanly with a concat, but this is faster.
|
|
|
6665 ;; concat's cause a lot of consing. So do regexp-quote's, but we can't
|
|
|
6666 ;; avoid it.
|
|
|
6667 ;; Probably doesn't make much sense for this to be an efs-defun, since
|
|
|
6668 ;; the host-type dependence is very mild.
|
|
|
6669 (`
|
|
|
6670 (let ((path (, path)) ; expand once
|
|
|
6671 (ignore-case (, ignore-case))
|
|
|
6672 str)
|
|
|
6673 ;; eliminate flat file systems -- should have a constant for this
|
|
|
6674 (or (memq (, host-type) '(mts cms mvs cms-knet))
|
|
|
6675 (efs-save-match-data
|
|
|
6676 (catch 'foo
|
|
|
6677 (efs-map-hashtable
|
|
|
6678 (function
|
|
|
6679 (lambda (key val)
|
|
|
6680 (and (eq (string-match (regexp-quote key) path) 0)
|
|
|
6681 (setq str (substring path (match-end 0)))
|
|
|
6682 (string-match "^[^/]+" str)
|
|
|
6683 (not (efs-hash-entry-exists-p
|
|
|
6684 (substring str 0 (match-end 0))
|
|
|
6685 val ignore-case))
|
|
|
6686 (throw 'foo nil))))
|
|
|
6687 efs-files-hashtable)
|
|
|
6688 t))))))
|
|
|
6689
|
|
|
6690 (defun efs-file-entry-p (path)
|
|
|
6691 ;; Return whether there is a file entry for PATH.
|
|
|
6692 ;; Under no circumstances does this cause FTP activity.
|
|
|
6693 (let* ((path (directory-file-name (efs-canonize-file-name path)))
|
|
|
6694 (dir (file-name-directory path))
|
|
|
6695 (file (efs-get-file-part path))
|
|
|
6696 (tbl (efs-get-files-hashtable-entry dir)))
|
|
|
6697 (and tbl (efs-hash-entry-exists-p
|
|
|
6698 file tbl
|
|
|
6699 (memq (efs-host-type (car (efs-ftp-path dir)))
|
|
|
6700 efs-case-insensitive-host-types)) t)))
|
|
|
6701
|
|
|
6702 (defun efs-get-file-entry (path)
|
|
|
6703 "Return the given file entry for PATH.
|
|
|
6704 This is a list of the form \(type size owner modes nlinks modtm\),
|
|
|
6705 where type is nil for a normal file, t for a directory, and a string for a
|
|
|
6706 symlink, size is the size of the file in bytes, if known, and modes are
|
|
|
6707 the permission modes of the file as a string. modtm is short-term the
|
|
|
6708 cache of the file modtime. It is not used by `verify-visited-file-modtime'.
|
|
|
6709 If the file isn't in the hashtable, this returns nil."
|
|
|
6710 (let* ((path (directory-file-name (efs-canonize-file-name path)))
|
|
|
6711 (dir (file-name-directory path))
|
|
|
6712 (file (efs-get-file-part path))
|
|
|
6713 (parsed (efs-ftp-path dir))
|
|
|
6714 (host (car parsed))
|
|
|
6715 (host-type (efs-host-type host))
|
|
|
6716 (ent (efs-get-files-hashtable-entry dir))
|
|
|
6717 (ignore-case (memq host-type efs-case-insensitive-host-types)))
|
|
|
6718 (if ent
|
|
|
6719 (efs-get-hash-entry file ent ignore-case)
|
|
|
6720 (let ((user (nth 1 parsed))
|
|
|
6721 (r-dir (nth 2 parsed)))
|
|
|
6722 (and (efs-ancestral-check host-type path ignore-case)
|
|
|
6723 (or (and efs-allow-child-lookup
|
|
|
6724 (efs-allow-child-lookup host-type
|
|
|
6725 host user r-dir file)
|
|
|
6726 (setq ent (efs-get-files path t))
|
|
|
6727 (efs-get-hash-entry "." ent))
|
|
|
6728 ;; i.e. it's a directory by child lookup
|
|
|
6729 (efs-get-hash-entry
|
|
|
6730 file (efs-get-files dir) ignore-case)))))))
|
|
|
6731
|
|
|
6732 (defun efs-wipe-file-entries (host user)
|
|
|
6733 "Remove cache data for all files on HOST and USER.
|
|
|
6734 This replaces the file entry information hashtable with one that
|
|
|
6735 doesn't have any entries for the given HOST, USER pair."
|
|
|
6736 (let ((new-tbl (efs-make-hashtable (length efs-files-hashtable)))
|
|
|
6737 (host (downcase host))
|
|
|
6738 (case-fold (memq (efs-host-type host)
|
|
|
6739 efs-case-insensitive-host-types)))
|
|
|
6740 (if case-fold (setq user (downcase user)))
|
|
|
6741 (efs-map-hashtable
|
|
|
6742 (function
|
|
|
6743 (lambda (key val)
|
|
|
6744 (let ((parsed (efs-ftp-path key)))
|
|
|
6745 (if parsed
|
|
|
6746 (let ((h (nth 0 parsed))
|
|
|
6747 (u (nth 1 parsed)))
|
|
|
6748 (or (and (string-equal host (downcase h))
|
|
|
6749 (string-equal user (if case-fold (downcase u) u)))
|
|
|
6750 (efs-put-hash-entry key val new-tbl)))))))
|
|
|
6751 efs-files-hashtable)
|
|
|
6752 (setq efs-files-hashtable new-tbl)))
|
|
|
6753
|
|
|
6754
|
|
|
6755 ;;;; ============================================================
|
|
|
6756 ;;;; >8
|
|
|
6757 ;;;; Redefinitions of standard GNU Emacs functions.
|
|
|
6758 ;;;; ============================================================
|
|
|
6759
|
|
|
6760 ;;;; ------------------------------------------------------------
|
|
|
6761 ;;;; expand-file-name and friends...
|
|
|
6762 ;;;; ------------------------------------------------------------
|
|
|
6763
|
|
|
6764 ;; New filename expansion code for efs.
|
|
|
6765 ;; The overall structure is based around the following internal
|
|
|
6766 ;; functions and macros. Since these are internal, they do NOT
|
|
|
6767 ;; call efs-save-match-data. This is done by their calling
|
|
|
6768 ;; function.
|
|
|
6769 ;;
|
|
|
6770 ;; efs-expand-tilde
|
|
|
6771 ;; - expands all ~ constructs, both local and remote.
|
|
|
6772 ;; efs-short-circuit-file-name
|
|
|
6773 ;; - short-circuits //'s and /~'s, for both local and remote paths.
|
|
|
6774 ;; efs-de-dot-file-name
|
|
|
6775 ;; - canonizes /../ and /./'s in both local and remote paths.
|
|
|
6776 ;;
|
|
|
6777 ;; The following two functions overload existing emacs functions.
|
|
|
6778 ;; They are the entry points to this filename expansion code, and as such
|
|
|
6779 ;; call efs-save-match-data.
|
|
|
6780 ;;
|
|
|
6781 ;; efs-expand-file-name
|
|
|
6782 ;; efs-substitute-in-file-name
|
|
|
6783
|
|
|
6784 ;;; utility macros
|
|
|
6785
|
|
|
6786 (defmacro efs-short-circuit-file-name (filename)
|
|
|
6787 ;; Short-circuits //'s and /~'s in filenames.
|
|
|
6788 ;; Returns a list consisting of the local path,
|
|
|
6789 ;; host-type, host, user. For local hosts,
|
|
|
6790 ;; host-type, host, and user are all nil.
|
|
|
6791 (`
|
|
|
6792 (let ((start 0)
|
|
|
6793 (string (, filename))
|
|
|
6794 backskip regexp lbackskip
|
|
|
6795 lregexp parsed host-type host user)
|
|
|
6796
|
|
|
6797 (if efs-local-apollo-unix
|
|
|
6798 (setq lregexp ".//+"
|
|
|
6799 lbackskip 2)
|
|
|
6800 (setq lregexp "//+"
|
|
|
6801 lbackskip 1))
|
|
|
6802
|
|
|
6803 ;; Short circuit /user@mach: roots. It is important to do this
|
|
|
6804 ;; now to avoid unnecessary ftp connections.
|
|
|
6805
|
|
|
6806 (while (string-match efs-path-root-short-circuit-regexp string start)
|
|
|
6807 (setq start (1+ (match-beginning 0))))
|
|
|
6808 (or (zerop start) (setq string (substring string start)
|
|
|
6809 start 0))
|
|
|
6810
|
|
|
6811 ;; identify remote root
|
|
|
6812
|
|
|
6813 (if (setq parsed (efs-ftp-path-macro string))
|
|
|
6814 (if (memq (setq string (nth 2 parsed)
|
|
|
6815 host-type
|
|
|
6816 (efs-host-type (setq host (car parsed))
|
|
|
6817 (setq user (nth 1 parsed))))
|
|
|
6818 '(apollo-unix dumb-apollo-unix))
|
|
|
6819 (setq regexp ".//+"
|
|
|
6820 backskip 2)
|
|
|
6821 (setq regexp "//+"
|
|
|
6822 backskip 1))
|
|
|
6823 (setq regexp lregexp
|
|
|
6824 backskip lbackskip))
|
|
|
6825
|
|
|
6826 ;; Now short-circuit in an apollo and efs sensitive way.
|
|
|
6827
|
|
|
6828 (while (cond ((string-match regexp string start)
|
|
|
6829 (setq start (- (match-end 0) backskip)))
|
|
|
6830 ((string-match "/~" string start)
|
|
|
6831 (setq start (1- (match-end 0)))))
|
|
|
6832
|
|
|
6833 (and host-type
|
|
|
6834 (null efs-short-circuit-to-remote-root)
|
|
|
6835 (setq host-type nil
|
|
|
6836 regexp lregexp
|
|
|
6837 backskip lbackskip)))
|
|
|
6838 (or (zerop start) (setq string (substring string start)))
|
|
|
6839 (list string host-type (and host-type host) (and host-type user)))))
|
|
|
6840
|
|
|
6841 (defmacro efs-expand-tilde (tilde host-type host user)
|
|
|
6842 ;; Expands a TILDE (~ or ~sandy type construction)
|
|
|
6843 ;; Takes as an arg a filename (not directory name!)
|
|
|
6844 ;; and returns a filename. HOST-TYPE is the type of remote host.
|
|
|
6845 ;; nil is the type of the local host.
|
|
|
6846 (`
|
|
|
6847 (if (, host-type) ; nil host-type is the local machine
|
|
|
6848 (let* ((host (downcase (, host)))
|
|
|
6849 (host-type (, host-type))
|
|
|
6850 (ignore-case (memq host-type
|
|
|
6851 efs-case-insensitive-host-types))
|
|
|
6852 (tilde (, tilde))
|
|
|
6853 (user (, user))
|
|
|
6854 (key (concat host "/" user "/" tilde))
|
|
|
6855 (res (efs-get-hash-entry
|
|
|
6856 key efs-expand-dir-hashtable ignore-case)))
|
|
|
6857 (or res
|
|
|
6858 ;; for real accounts on unix systems, use the get trick
|
|
|
6859 (and (not (efs-anonymous-p user))
|
|
|
6860 (memq host-type efs-unix-host-types)
|
|
|
6861 (let ((line (nth 1 (efs-send-cmd
|
|
|
6862 host user
|
|
|
6863 (list 'get tilde "/dev/null")
|
|
|
6864 (format "expanding %s" tilde)))))
|
|
|
6865 (setq res
|
|
|
6866 (and (string-match efs-expand-dir-msgs line)
|
|
|
6867 (substring line
|
|
|
6868 (match-beginning 1)
|
|
|
6869 (match-end 1))))
|
|
|
6870 (if res
|
|
|
6871 (progn
|
|
|
6872 (setq res (efs-internal-directory-file-name res))
|
|
|
6873 (efs-put-hash-entry
|
|
|
6874 key res efs-expand-dir-hashtable ignore-case)
|
|
|
6875 res))))
|
|
|
6876 (progn
|
|
|
6877 (setq res
|
|
|
6878 (if (string-equal tilde "~")
|
|
|
6879 (car (efs-send-pwd
|
|
|
6880 host-type host user))
|
|
|
6881 (let* ((home-key (concat host "/" user "/~"))
|
|
|
6882 (home (efs-get-hash-entry
|
|
|
6883 home-key efs-expand-dir-hashtable
|
|
|
6884 ignore-case))
|
|
|
6885 pwd-result)
|
|
|
6886 (if home
|
|
|
6887 (setq home
|
|
|
6888 (efs-fix-path
|
|
|
6889 host-type
|
|
|
6890 (efs-internal-file-name-as-directory
|
|
|
6891 host-type home)))
|
|
|
6892 (if (setq home
|
|
|
6893 (car
|
|
|
6894 (setq pwd-result
|
|
|
6895 (efs-send-pwd
|
|
|
6896 host-type
|
|
|
6897 host user))))
|
|
|
6898 (efs-put-hash-entry
|
|
|
6899 home-key
|
|
|
6900 (efs-internal-directory-file-name
|
|
|
6901 (efs-fix-path host-type home 'reverse))
|
|
|
6902 efs-expand-dir-hashtable ignore-case)
|
|
|
6903 (efs-error host user
|
|
|
6904 (concat "PWD failed: "
|
|
|
6905 (cdr pwd-result)))))
|
|
|
6906 (unwind-protect
|
|
|
6907 (and (efs-raw-send-cd host user
|
|
|
6908 (efs-fix-path
|
|
|
6909 host-type tilde) t)
|
|
|
6910 (car
|
|
|
6911 (efs-send-pwd
|
|
|
6912 host-type host user)))
|
|
|
6913 (efs-raw-send-cd host user home)))))
|
|
|
6914 (if res
|
|
|
6915 (progn
|
|
|
6916 (setq res (efs-internal-directory-file-name
|
|
|
6917 (efs-fix-path host-type res 'reverse)))
|
|
|
6918 (efs-put-hash-entry
|
|
|
6919 key res efs-expand-dir-hashtable ignore-case)
|
|
|
6920 res)))
|
|
|
6921 (if (string-equal tilde "~")
|
|
|
6922 (error "Cannot get home directory on %s" host)
|
|
|
6923 (error "User %s is not known on %s" (substring tilde 1) host))))
|
|
|
6924 ;; local machine
|
|
|
6925 (efs-real-expand-file-name (, tilde)))))
|
|
|
6926
|
|
|
6927 (defmacro efs-de-dot-file-name (string)
|
|
|
6928 ;; Takes a string as arguments, and removes /../'s and /./'s.
|
|
|
6929 (`
|
|
|
6930 (let ((string (, string))
|
|
|
6931 (start 0)
|
|
|
6932 new make-dir)
|
|
|
6933 ;; to make the regexp's simpler, canonicalize to directory name.
|
|
|
6934 (if (setq make-dir (string-match "/\\.\\.?$" string))
|
|
|
6935 (setq string (concat string "/")))
|
|
|
6936 (while (string-match "/\\./" string start)
|
|
|
6937 (setq new (concat new
|
|
|
6938 (substring string
|
|
|
6939 start (match-beginning 0)))
|
|
|
6940 start (1- (match-end 0))))
|
|
|
6941
|
|
|
6942 (if new (setq string (concat new (substring string start))))
|
|
|
6943
|
|
|
6944 (while (string-match "/[^/]+/\\.\\./" string)
|
|
|
6945 ;; Is there a way to avoid all this concating and copying?
|
|
|
6946 (setq string (concat (substring string 0 (1+ (match-beginning 0)))
|
|
|
6947 (substring string (match-end 0)))))
|
|
|
6948
|
|
|
6949 ;; Do /../ and //../ special cases. They should expand to
|
|
|
6950 ;; / and //, respectively.
|
|
|
6951 (if (string-match "^\\(/+\\)\\.\\./" string)
|
|
|
6952 (setq string (concat (substring string 0 (match-end 1))
|
|
|
6953 (substring string (match-end 0)))))
|
|
|
6954
|
|
|
6955 (if (and make-dir
|
|
|
6956 (not (string-match "^/+$" string)))
|
|
|
6957 (substring string 0 -1)
|
|
|
6958 string))))
|
|
|
6959
|
|
|
6960 (defun efs-substitute-in-file-name (string)
|
|
|
6961 "Documented as original."
|
|
|
6962 ;; Because of the complicated interaction between short-circuiting
|
|
|
6963 ;; and environment variable substitution, this can't call the macro
|
|
|
6964 ;; efs-short-circuit-file-name.
|
|
|
6965 (efs-save-match-data
|
|
|
6966 (let ((start 0)
|
|
|
6967 var new root backskip regexp lbackskip
|
|
|
6968 lregexp parsed fudge-host-type rstart error)
|
|
|
6969
|
|
|
6970 (if efs-local-apollo-unix
|
|
|
6971 (setq lregexp ".//+"
|
|
|
6972 lbackskip 2)
|
|
|
6973 (setq lregexp "//+"
|
|
|
6974 lbackskip 1))
|
|
|
6975
|
|
|
6976 ;; Subst. existing env variables
|
|
|
6977 (while (string-match "\\$" string start)
|
|
|
6978 (setq new (concat new (substring string start (match-beginning 0)))
|
|
|
6979 start (match-end 0))
|
|
|
6980 (cond ((eq (string-match "\\$" string start) start)
|
|
|
6981 (setq start (1+ start)
|
|
|
6982 new (concat new "$$")))
|
|
|
6983 ((eq (string-match "{" string start) start)
|
|
|
6984 (if (and (string-match "}" string start)
|
|
|
6985 (setq var (getenv
|
|
|
6986 (substring string (1+ start)
|
|
|
6987 (1- (match-end 0))))))
|
|
|
6988 (setq start (match-end 0)
|
|
|
6989 new (concat new var))
|
|
|
6990 (setq new (concat new "$"))))
|
|
|
6991 ((eq (string-match "[a-zA-Z0-9]+" string start) start)
|
|
|
6992 (if (setq var (getenv
|
|
|
6993 (substring string start (match-end 0))))
|
|
|
6994 (setq start (match-end 0)
|
|
|
6995 new (concat new var))
|
|
|
6996 (setq new (concat new "$"))))
|
|
|
6997 ((setq new (concat new "$")))))
|
|
|
6998 (if new (setq string (concat new (substring string start))
|
|
|
6999 start 0))
|
|
|
7000
|
|
|
7001 ;; Short circuit /user@mach: roots. It is important to do this
|
|
|
7002 ;; now to avoid unnecessary ftp connections.
|
|
|
7003
|
|
|
7004 (while (string-match efs-path-root-short-circuit-regexp
|
|
|
7005 string start)
|
|
|
7006 (setq start (1+ (match-beginning 0))))
|
|
|
7007 (or (zerop start) (setq string (substring string start)
|
|
|
7008 start 0))
|
|
|
7009
|
|
|
7010 ;; Look for invalid environment variables in the root. If one is found,
|
|
|
7011 ;; we set the host-type to 'unix. Since we can't login in to determine
|
|
|
7012 ;; it. There is a good chance that we will bomb later with an error,
|
|
|
7013 ;; but the day may yet be saved if the root is short-circuited off.
|
|
|
7014
|
|
|
7015 (if (string-match efs-path-root-regexp string)
|
|
|
7016 (progn
|
|
|
7017 (setq root (substring string 0 (match-end 0))
|
|
|
7018 start (match-end 0))
|
|
|
7019 (if (string-match "[^$]\\(\\$\\$\\)*\\$[^$]" root)
|
|
|
7020 (progn
|
|
|
7021 (setq rstart (1- (match-end 0))
|
|
|
7022 fudge-host-type t)
|
|
|
7023 (cond
|
|
|
7024 ((eq (elt root rstart) ?{)
|
|
|
7025 (setq
|
|
|
7026 error
|
|
|
7027 (if (string-match "}" root rstart)
|
|
|
7028 (concat
|
|
|
7029 "Subsituting non-existent environment variable "
|
|
|
7030 (substring root (1+ rstart) (match-beginning 0)))
|
|
|
7031 "Missing \"}\" in environment-variable substitution")))
|
|
|
7032 ((eq (string-match "[A-Za-z0-9]+" root rstart) rstart)
|
|
|
7033 (setq
|
|
|
7034 error
|
|
|
7035 (concat
|
|
|
7036 "Subsituting non-existent environment variable "
|
|
|
7037 (substring root rstart (match-beginning 0)))))
|
|
|
7038 (t
|
|
|
7039 (setq
|
|
|
7040 error
|
|
|
7041 "Bad format environment-variable substitution")))))
|
|
|
7042 (setq root (efs-unquote-dollars root)
|
|
|
7043 parsed (efs-ftp-path root))
|
|
|
7044
|
|
|
7045 (if (and (not fudge-host-type)
|
|
|
7046 ;; This may trigger an FTP connection
|
|
|
7047 (memq (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7048 '(apollo-unix dumb-apollo-unix)))
|
|
|
7049 (setq regexp ".//+"
|
|
|
7050 backskip 2)
|
|
|
7051 (setq regexp "//+"
|
|
|
7052 backskip 1)))
|
|
|
7053 ;; no root, we're local
|
|
|
7054 (setq regexp lregexp
|
|
|
7055 backskip lbackskip))
|
|
|
7056
|
|
|
7057 ;; Now short-circuit in an apollo and efs sensitive way.
|
|
|
7058
|
|
|
7059 (while (cond ((string-match regexp string start)
|
|
|
7060 (setq start (- (match-end 0) backskip)))
|
|
|
7061 ((string-match "/~" string start)
|
|
|
7062 (setq start (1- (match-end 0)))))
|
|
|
7063
|
|
|
7064 (and root
|
|
|
7065 (null efs-short-circuit-to-remote-root)
|
|
|
7066 (setq root nil
|
|
|
7067 regexp lregexp
|
|
|
7068 backskip lbackskip)))
|
|
|
7069
|
|
|
7070 ;; If we still have a bad root, barf.
|
|
|
7071 (if (and root error) (error error))
|
|
|
7072
|
|
|
7073 ;; look for non-existent evironment variables in the path
|
|
|
7074
|
|
|
7075 (if (string-match
|
|
|
7076 "\\([^$]\\|^\\)\\(\\$\\$\\)*\\$\\([^$]\\|$\\)" string start)
|
|
|
7077 (progn
|
|
|
7078 (setq start (match-beginning 3))
|
|
|
7079 (cond
|
|
|
7080 ((eq (length string) start)
|
|
|
7081 (error "Empty string is an invalid environment variable"))
|
|
|
7082 ((eq (elt string start) ?{)
|
|
|
7083 (if (string-match "}" string start)
|
|
|
7084 (error
|
|
|
7085 "Subsituting non-existent environment variable %s"
|
|
|
7086 (substring string (1+ start) (match-end 0)))
|
|
|
7087 (error
|
|
|
7088 "Missing \"}\" in environment-variable substitution")))
|
|
|
7089 ((eq (string-match "[A-Za-z0-9]+" string start) start)
|
|
|
7090 (error
|
|
|
7091 "Subsituting non-existent environment variable %s"
|
|
|
7092 (substring string start (match-end 0))))
|
|
|
7093 (t
|
|
|
7094 (error
|
|
|
7095 "Bad format environment-variable substitution")))))
|
|
|
7096
|
|
|
7097 (if root
|
|
|
7098 (concat root
|
|
|
7099 (efs-unquote-dollars
|
|
|
7100 (if (zerop start)
|
|
|
7101 string
|
|
|
7102 (substring string start))))
|
|
|
7103 (efs-unquote-dollars
|
|
|
7104 (if (zerop start)
|
|
|
7105 string
|
|
|
7106 (substring string start)))))))
|
|
|
7107
|
|
|
7108 (defun efs-expand-file-name (name &optional default)
|
|
|
7109 "Documented as original."
|
|
|
7110 (let (s-c-res path host user host-type)
|
|
|
7111 (efs-save-match-data
|
|
|
7112 (or (file-name-absolute-p name)
|
|
|
7113 (setq name (concat
|
|
|
7114 (file-name-as-directory
|
|
|
7115 (or default default-directory))
|
|
|
7116 name)))
|
|
|
7117 (setq s-c-res (efs-short-circuit-file-name name)
|
|
|
7118 path (car s-c-res)
|
|
|
7119 host-type (nth 1 s-c-res)
|
|
|
7120 host (nth 2 s-c-res)
|
|
|
7121 user (nth 3 s-c-res))
|
|
|
7122 (cond ((string-match "^~[^/]*" path)
|
|
|
7123 (let ((start (match-end 0)))
|
|
|
7124 (setq path (concat
|
|
|
7125 (efs-expand-tilde
|
|
|
7126 (substring path 0 start)
|
|
|
7127 host-type host user)
|
|
|
7128 (substring path start)))))
|
|
|
7129 ((and host-type (not (file-name-absolute-p path)))
|
|
|
7130 ;; We expand the empty string to a directory.
|
|
|
7131 ;; This can be more efficient for filename
|
|
|
7132 ;; completion. It's also consistent with non-unix.
|
|
|
7133 (let ((tilde (efs-expand-tilde
|
|
|
7134 "~" host-type host user)))
|
|
|
7135 (if (string-equal tilde "/")
|
|
|
7136 (setq path (concat "/" path))
|
|
|
7137 (setq path (concat tilde "/" path))))))
|
|
|
7138
|
|
|
7139 (setq path (efs-de-dot-file-name path))
|
|
|
7140 (if host-type
|
|
|
7141 (format efs-path-format-string user host path)
|
|
|
7142 path))))
|
|
|
7143
|
|
|
7144 ;;;; ------------------------------------------------------------
|
|
|
7145 ;;;; Other functions for manipulating file names.
|
|
|
7146 ;;;; ------------------------------------------------------------
|
|
|
7147
|
|
|
7148 (defun efs-internal-file-name-extension (filename)
|
|
|
7149 ;; Returns the extension for file name FN.
|
|
|
7150 (save-match-data
|
|
|
7151 (let ((file (file-name-sans-versions (file-name-nondirectory filename))))
|
|
|
7152 (if (string-match "\\.[^.]*\\'" file)
|
|
|
7153 (substring file (match-beginning 0))
|
|
|
7154 ""))))
|
|
|
7155
|
|
|
7156 (defun efs-file-name-as-directory (name)
|
|
|
7157 ;; version of file-name-as-directory for remote files.
|
|
|
7158 ;; Usually just appends a / if there isn't one already.
|
|
|
7159 ;; For some systems, it may also remove .DIR like extensions.
|
|
|
7160 (let* ((parsed (efs-ftp-path name))
|
|
|
7161 (file (nth 2 parsed)))
|
|
|
7162 (if (string-equal file "")
|
|
|
7163 name
|
|
|
7164 (efs-internal-file-name-as-directory
|
|
|
7165 (efs-host-type (car parsed) (nth 1 parsed)) name))))
|
|
|
7166
|
|
|
7167 (efs-defun efs-internal-file-name-as-directory nil (name)
|
|
|
7168 ;; By default, simply adds a trailing /, if there isn't one.
|
|
|
7169 ;; Note that for expanded filenames, it pays to call this rather
|
|
|
7170 ;; than efs-file-name-as-directory.
|
|
|
7171 (let (file-name-handler-alist)
|
|
|
7172 (file-name-as-directory name)))
|
|
|
7173
|
|
|
7174 (defun efs-file-name-directory (name)
|
|
|
7175 ;; file-name-directory for remote files. Takes care not to
|
|
|
7176 ;; turn /user@host: into /.
|
|
|
7177 (let ((path (nth 2 (efs-ftp-path name)))
|
|
|
7178 file-name-handler-alist)
|
|
|
7179 (if (or (string-equal path "")
|
|
|
7180 (and (= (string-to-char path) ?~)
|
|
|
7181 (not
|
|
|
7182 (efs-save-match-data
|
|
|
7183 (string-match "/" path 1)))))
|
|
|
7184 name
|
|
|
7185 (if (efs-save-match-data
|
|
|
7186 (not (string-match "/" path)))
|
|
|
7187 (efs-replace-path-component name "")
|
|
|
7188 (file-name-directory name)))))
|
|
|
7189
|
|
|
7190 (defun efs-file-name-nondirectory (name)
|
|
|
7191 ;; Computes file-name-nondirectory for remote files.
|
|
|
7192 ;; For expanded filenames, can just call efs-internal-file-name-nondirectory.
|
|
|
7193 (let ((file (nth 2 (efs-ftp-path name))))
|
|
|
7194 (if (or (string-equal file "")
|
|
|
7195 (and (= (string-to-char file) ?~)
|
|
|
7196 (not
|
|
|
7197 (efs-save-match-data
|
|
|
7198 (string-match "/" file 1)))))
|
|
|
7199 ""
|
|
|
7200 (if (efs-save-match-data
|
|
|
7201 (not (string-match "/" file)))
|
|
|
7202 file
|
|
|
7203 (efs-internal-file-name-nondirectory name)))))
|
|
|
7204
|
|
|
7205 (defun efs-internal-file-name-nondirectory (name)
|
|
|
7206 ;; Version of file-name-nondirectory, without the efs-file-handler-function.
|
|
|
7207 ;; Useful to call this, if we have already decomposed the filename.
|
|
|
7208 (let (file-name-handler-alist)
|
|
|
7209 (file-name-nondirectory name)))
|
|
|
7210
|
|
|
7211 (defun efs-directory-file-name (dir)
|
|
|
7212 ;; Computes directory-file-name for remote files.
|
|
|
7213 ;; Needs to be careful not to turn /foo@bar:/ into /foo@bar:
|
|
|
7214 (let ((parsed (efs-ftp-path dir)))
|
|
|
7215 (if (string-equal "/" (nth 2 parsed))
|
|
|
7216 dir
|
|
|
7217 (efs-internal-directory-file-name dir))))
|
|
|
7218
|
|
|
7219 (defun efs-internal-directory-file-name (dir)
|
|
|
7220 ;; Call this if you want to apply directory-file-name to the remote
|
|
|
7221 ;; part of a efs-style path. Don't call for non-efs-style paths,
|
|
|
7222 ;; as this short-circuits the file-name-handler-alist completely.
|
|
|
7223 (let (file-name-handler-alist)
|
|
|
7224 (directory-file-name dir)))
|
|
|
7225
|
|
|
7226 (efs-defun efs-remote-directory-file-name nil (dir)
|
|
|
7227 "Returns the file name on the remote system of directory DIR.
|
|
|
7228 If the remote system is not unix, this may not be the same as the file name
|
|
|
7229 of the directory in efs's internal cache."
|
|
|
7230 (directory-file-name dir))
|
|
|
7231
|
|
|
7232 (defun efs-file-name-sans-versions (filename &optional keep-backup-versions)
|
|
|
7233 ;; Version of file-name-sans-versions for remote files.
|
|
|
7234 (or (file-name-absolute-p filename)
|
|
|
7235 (setq filename (expand-file-name filename)))
|
|
|
7236 (let ((parsed (efs-ftp-path filename)))
|
|
|
7237 (efs-internal-file-name-sans-versions
|
|
|
7238 (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7239 filename keep-backup-versions)))
|
|
|
7240
|
|
|
7241 (efs-defun efs-internal-file-name-sans-versions nil
|
|
|
7242 (filename &optional keep-backup-versions)
|
|
|
7243 (let (file-name-handler-alist)
|
|
|
7244 (file-name-sans-versions filename keep-backup-versions)))
|
|
|
7245
|
|
|
7246 (defun efs-diff-latest-backup-file (fn)
|
|
|
7247 ;; Version of diff latest backup file for remote files.
|
|
|
7248 ;; Accomodates non-unix.
|
|
|
7249 ;; Returns the latest backup for fn, according to the numbering
|
|
|
7250 ;; of the backups. Does not check file-newer-than-file-p.
|
|
|
7251 (let ((parsed (efs-ftp-path fn)))
|
|
|
7252 (efs-internal-diff-latest-backup-file
|
|
|
7253 (efs-host-type (car parsed) (nth 1 parsed)) fn)))
|
|
|
7254
|
|
|
7255 (efs-defun efs-internal-diff-latest-backup-file nil (fn)
|
|
|
7256 ;; Default behaviour is the behaviour in diff.el
|
|
|
7257 (let (file-name-handler-alist)
|
|
|
7258 (diff-latest-backup-file fn)))
|
|
|
7259
|
|
|
7260 (defun efs-unhandled-file-name-directory (filename)
|
|
|
7261 ;; Calculate a default unhandled directory for an efs buffer.
|
|
|
7262 ;; This is used to compute directories in which to execute
|
|
|
7263 ;; processes. This is relevant to V19 only. Doesn't do any harm for
|
|
|
7264 ;; older versions though. It would be nice if this wasn't such a
|
|
|
7265 ;; kludge.
|
|
|
7266 (file-name-directory efs-tmp-name-template))
|
|
|
7267
|
|
|
7268 (defun efs-file-truename (filename)
|
|
|
7269 ;; Calculates a remote file's truename, if this isn't inhibited.
|
|
|
7270 (let ((filename (expand-file-name filename)))
|
|
|
7271 (if (and efs-compute-remote-buffer-file-truename
|
|
|
7272 (memq (efs-host-type (car (efs-ftp-path filename)))
|
|
|
7273 efs-unix-host-types))
|
|
|
7274 (efs-internal-file-truename filename)
|
|
|
7275 filename)))
|
|
|
7276
|
|
|
7277 (defun efs-internal-file-truename (filename)
|
|
|
7278 ;; Internal function so that we don't keep checking
|
|
|
7279 ;; efs-compute-remote-buffer-file-truename, etc, as we recurse.
|
|
|
7280 (let ((dir (efs-file-name-directory filename))
|
|
|
7281 target dirfile)
|
|
|
7282 ;; Get the truename of the directory.
|
|
|
7283 (setq dirfile (efs-directory-file-name dir))
|
|
|
7284 ;; If these are equal, we have the (or a) root directory.
|
|
|
7285 (or (string= dir dirfile)
|
|
|
7286 (setq dir (efs-file-name-as-directory
|
|
|
7287 (efs-internal-file-truename dirfile))))
|
|
|
7288 (if (equal ".." (efs-file-name-nondirectory filename))
|
|
|
7289 (efs-directory-file-name (efs-file-name-directory
|
|
|
7290 (efs-directory-file-name dir)))
|
|
|
7291 (if (equal "." (efs-file-name-nondirectory filename))
|
|
|
7292 (efs-directory-file-name dir)
|
|
|
7293 ;; Put it back on the file name.
|
|
|
7294 (setq filename (concat dir (efs-file-name-nondirectory filename)))
|
|
|
7295 ;; Is the file name the name of a link?
|
|
|
7296 (setq target (efs-file-symlink-p filename))
|
|
|
7297 (if target
|
|
|
7298 ;; Yes => chase that link, then start all over
|
|
|
7299 ;; since the link may point to a directory name that uses links.
|
|
|
7300 ;; We can't safely use expand-file-name here
|
|
|
7301 ;; since target might look like foo/../bar where foo
|
|
|
7302 ;; is itself a link. Instead, we handle . and .. above.
|
|
|
7303 (if (file-name-absolute-p target)
|
|
|
7304 (efs-internal-file-truename target)
|
|
|
7305 (efs-internal-file-truename (concat dir target)))
|
|
|
7306 ;; No, we are done!
|
|
|
7307 filename)))))
|
|
|
7308
|
|
|
7309
|
|
|
7310 ;;;; ----------------------------------------------------------------
|
|
|
7311 ;;;; I/O functions
|
|
|
7312 ;;;; ----------------------------------------------------------------
|
|
|
7313
|
|
|
7314 (efs-define-fun efs-set-buffer-file-name (filename)
|
|
|
7315 ;; Sets the buffer local variables for filename appropriately.
|
|
|
7316 ;; A special function because Lucid and FSF do this differently.
|
|
|
7317 ;; This default behaviour is the lowest common denominator.
|
|
|
7318 (setq buffer-file-name filename))
|
|
|
7319
|
|
|
7320 (defun efs-write-region (start end filename &optional append visit &rest args)
|
|
|
7321 ;; write-region for remote files.
|
|
|
7322 ;; This version accepts the V19 interpretation for the arg VISIT.
|
|
|
7323 ;; However, making use of this within V18 may cause errors to crop up.
|
|
|
7324 ;; ARGS should catch the MULE coding-system argument.
|
|
|
7325 (if (stringp visit) (setq visit (expand-file-name visit)))
|
|
|
7326 (setq filename (expand-file-name filename))
|
|
|
7327 (let ((parsed (efs-ftp-path filename))
|
|
|
7328 ;; Make sure that the after-write-region-hook isn't called inside
|
|
|
7329 ;; the file-handler-alist
|
|
|
7330 (after-write-region-hook nil))
|
|
|
7331 (if parsed
|
|
|
7332 (let* ((host (car parsed))
|
|
|
7333 (user (nth 1 parsed))
|
|
|
7334 (host-type (efs-host-type host user))
|
|
|
7335 (temp (car (efs-make-tmp-name nil host)))
|
|
|
7336 (type (efs-xfer-type nil nil host-type filename))
|
|
|
7337 (abbr (and (or (stringp visit) (eq t visit) (null visit))
|
|
|
7338 (efs-relativize-filename
|
|
|
7339 (if (stringp visit) visit filename))))
|
|
|
7340 (buffer (current-buffer))
|
|
|
7341 (b-file-name buffer-file-name)
|
|
|
7342 (mod-p (buffer-modified-p)))
|
|
|
7343 (unwind-protect
|
|
|
7344 (progn
|
|
|
7345 (condition-case err
|
|
|
7346 (progn
|
|
|
7347 (unwind-protect
|
|
|
7348 (let ((executing-macro t))
|
|
|
7349 ;; let-bind executing-macro to inhibit messaging.
|
|
|
7350 ;; Setting VISIT to 'quiet is more elegant.
|
|
|
7351 ;; But in Emacs 18, doing it this way allows
|
|
|
7352 ;; us to modify the visited file modtime, so
|
|
|
7353 ;; that undo's show the buffer modified.
|
|
|
7354 (apply 'write-region start end
|
|
|
7355 temp nil visit args))
|
|
|
7356 ;; buffer-modified-p is now correctly set
|
|
|
7357 (setq buffer-file-name b-file-name)
|
|
|
7358 ;; File modtime is bogus, so clear.
|
|
|
7359 (clear-visited-file-modtime))
|
|
|
7360 (efs-copy-file-internal
|
|
|
7361 temp nil filename parsed (if append 'append t)
|
|
|
7362 nil (and abbr (format "Writing %s" abbr))
|
|
|
7363 ;; cont
|
|
|
7364 (efs-cont (result line cont-lines) (filename buffer
|
|
|
7365 visit)
|
|
|
7366 (if result
|
|
|
7367 (signal 'ftp-error
|
|
|
7368 (list "Opening output file"
|
|
|
7369 (format "FTP Error: \"%s\"" line)
|
|
|
7370 filename)))
|
|
|
7371 ;; The new file entry will be added by
|
|
|
7372 ;; efs-copy-file-internal.
|
|
|
7373 (cond
|
|
|
7374 ((eq visit t)
|
|
|
7375 ;; This will run asynch.
|
|
|
7376 (efs-save-buffer-excursion
|
|
|
7377 (set-buffer buffer)
|
|
|
7378 (efs-set-buffer-file-name filename)
|
|
|
7379 (efs-set-visited-file-modtime)))
|
|
|
7380 ((stringp visit)
|
|
|
7381 (efs-save-buffer-excursion
|
|
|
7382 (set-buffer buffer)
|
|
|
7383 (efs-set-buffer-file-name visit)
|
|
|
7384 (set-visited-file-modtime)))))
|
|
|
7385 nil type))
|
|
|
7386 (error
|
|
|
7387 ;; restore buffer-modified-p
|
|
|
7388 (let (file-name-handler-alist)
|
|
|
7389 (set-buffer-modified-p mod-p))
|
|
|
7390 (signal (car err) (cdr err))))
|
|
|
7391 (if (or (eq visit t)
|
|
|
7392 (and (stringp visit)
|
|
|
7393 (efs-ftp-path visit)))
|
|
|
7394 (efs-set-buffer-mode)))
|
|
|
7395 (efs-del-tmp-name temp))
|
|
|
7396 (and abbr (efs-message "Wrote %s" abbr)))
|
|
|
7397 (if (and (stringp visit) (efs-ftp-path visit))
|
|
|
7398 (progn
|
|
|
7399 (apply 'write-region start end filename append visit args)
|
|
|
7400 (efs-set-buffer-file-name visit)
|
|
|
7401 (efs-set-visited-file-modtime)
|
|
|
7402 (efs-set-buffer-mode))
|
|
|
7403 (error "efs-write-region called for a local file")))))
|
|
|
7404
|
|
|
7405 (defun efs-insert-file-contents (filename &optional visit &rest args)
|
|
|
7406 ;; Inserts file contents for remote files.
|
|
|
7407 ;; The additional ARGS covers V19 BEG and END. Should also handle the
|
|
|
7408 ;; CODING-SYSTEM arg for mule. Hope the two don't trip over each other.
|
|
|
7409 (barf-if-buffer-read-only)
|
|
|
7410 (unwind-protect
|
|
|
7411 (let* ((filename (expand-file-name filename))
|
|
|
7412 (parsed (efs-ftp-path filename))
|
|
|
7413 (host (car parsed))
|
|
|
7414 (host-type (efs-host-type host))
|
|
|
7415 (user (nth 1 parsed))
|
|
|
7416 (path (nth 2 parsed))
|
|
|
7417 (buffer (current-buffer)))
|
|
|
7418
|
|
|
7419 (if (or (file-exists-p filename)
|
|
|
7420 (let* ((res (and
|
|
|
7421 (not (efs-get-host-property host 'rnfr-failed))
|
|
|
7422 (efs-send-cmd
|
|
|
7423 host user (list 'quote 'rnfr path))))
|
|
|
7424 (line (nth 1 res)))
|
|
|
7425 ;; RNFR returns a 550 if the file doesn't exist.
|
|
|
7426 (if (and line (>= (length line) 4)
|
|
|
7427 (string-equal "550 " (substring line 0 4)))
|
|
|
7428 nil
|
|
|
7429 (if (car res) (efs-set-host-property host 'rnfr-failed t))
|
|
|
7430 (efs-del-from-ls-cache filename t nil)
|
|
|
7431 (efs-del-hash-entry
|
|
|
7432 (efs-canonize-file-name (file-name-directory filename))
|
|
|
7433 efs-files-hashtable)
|
|
|
7434 (file-exists-p filename))))
|
|
|
7435
|
|
|
7436 (let ((temp (concat
|
|
|
7437 (car (efs-make-tmp-name nil host))
|
|
|
7438 (efs-internal-file-name-extension filename)))
|
|
|
7439 (type (efs-xfer-type host-type filename nil nil))
|
|
|
7440 (abbr (efs-relativize-filename filename))
|
|
|
7441 (temp (concat (car (efs-make-tmp-name nil host))
|
|
|
7442 (or (substring abbr (string-match "\\." abbr)) "")))
|
|
|
7443 (i-f-c-size 0))
|
|
|
7444
|
|
|
7445 (unwind-protect
|
|
|
7446 (efs-copy-file-internal
|
|
|
7447 filename parsed temp nil t nil
|
|
|
7448 (format "Retrieving %s" abbr)
|
|
|
7449 (efs-cont (result line cont-lines) (filename visit buffer
|
|
|
7450 host-type
|
|
|
7451 temp args)
|
|
|
7452 (if result
|
|
|
7453 (signal 'ftp-error
|
|
|
7454 (list "Opening input file"
|
|
|
7455 (format "FTP Error: \"%s\""
|
|
|
7456 line)
|
|
|
7457 filename))
|
|
|
7458 (if (eq host-type 'coke)
|
|
|
7459 (efs-coke-insert-beverage-contents buffer filename
|
|
|
7460 line)
|
|
|
7461 (efs-save-buffer-excursion
|
|
|
7462 (set-buffer buffer)
|
|
|
7463 (if (or (file-readable-p temp)
|
|
|
7464 (sleep-for efs-retry-time)
|
|
|
7465 ;; Wait for file to hopefully appear.
|
|
|
7466 (file-readable-p temp))
|
|
|
7467
|
|
|
7468 (setq i-f-c-size
|
|
|
7469 (nth 1 (apply 'insert-file-contents
|
|
|
7470 temp visit args)))
|
|
|
7471 (signal 'ftp-error
|
|
|
7472 (list
|
|
|
7473 "Opening input file:"
|
|
|
7474 (format
|
|
|
7475 "FTP Error: %s not arrived or readable"
|
|
|
7476 filename))))
|
|
|
7477 ;; This is done asynch
|
|
|
7478 (if visit
|
|
|
7479 (let ((buffer-file-name filename))
|
|
|
7480 (efs-set-visited-file-modtime)))))))
|
|
|
7481 nil type)
|
|
|
7482 (efs-del-tmp-name temp))
|
|
|
7483 ;; Return (FILENAME SIZE)
|
|
|
7484 (list filename i-f-c-size))
|
|
|
7485 (signal 'file-error (list "Opening input file" filename))))
|
|
|
7486 ;; Set buffer-file-name at the very last, so if anything bombs, we're
|
|
|
7487 ;; not visiting.
|
|
|
7488 (if visit
|
|
|
7489 (efs-set-buffer-file-name filename))))
|
|
|
7490
|
|
|
7491 (defun efs-revert-buffer (arg noconfirm)
|
|
|
7492 "Revert this buffer from a remote file using ftp."
|
|
|
7493 (let ((opoint (point)))
|
|
|
7494 (cond ((null buffer-file-name)
|
|
|
7495 (error "Buffer does not seem to be associated with any file"))
|
|
|
7496 ((or noconfirm
|
|
|
7497 (yes-or-no-p (format "Revert buffer from file %s? "
|
|
|
7498 buffer-file-name)))
|
|
|
7499 (let ((buffer-read-only nil))
|
|
|
7500 ;; Set buffer-file-name to nil
|
|
|
7501 ;; so that we don't try to lock the file.
|
|
|
7502 (let ((buffer-file-name nil))
|
|
|
7503 (unlock-buffer)
|
|
|
7504 (erase-buffer))
|
|
|
7505 (insert-file-contents buffer-file-name t))
|
|
|
7506 (goto-char (min opoint (point-max)))
|
|
|
7507 (after-find-file nil)
|
|
|
7508 t))))
|
|
|
7509
|
|
|
7510 (defun efs-recover-file (file)
|
|
|
7511 ;; Version of recover file for remote files, and remote autosave files too.
|
|
|
7512 (if (auto-save-file-name-p file) (error "%s is an auto-save file" file))
|
|
|
7513 (let* ((file-name (let ((buffer-file-name file)) (make-auto-save-file-name)))
|
|
|
7514 (file-name-parsed (efs-ftp-path file-name))
|
|
|
7515 (file-parsed (efs-ftp-path file))
|
|
|
7516 (efs-ls-uncache t))
|
|
|
7517 (cond ((not (file-newer-than-file-p file-name file))
|
|
|
7518 (error "Auto-save file %s not current" file-name))
|
|
|
7519 ((save-window-excursion
|
|
|
7520 (or (eq system-type 'vax-vms)
|
|
|
7521 (progn
|
|
|
7522 (with-output-to-temp-buffer "*Directory*"
|
|
|
7523 (buffer-disable-undo standard-output)
|
|
|
7524 (if file-parsed
|
|
|
7525 (progn
|
|
|
7526 (princ (format "On the host %s:\n"
|
|
|
7527 (car file-parsed)))
|
|
|
7528 (princ
|
|
|
7529 (let ((default-directory exec-directory))
|
|
|
7530 (efs-ls file (if (file-symlink-p file)
|
|
|
7531 "-lL" "-l")
|
|
|
7532 t t))))
|
|
|
7533 (princ "On the local host:\n")
|
|
|
7534 (let ((default-directory exec-directory))
|
|
|
7535 (call-process "ls" nil standard-output nil
|
|
|
7536 (if (file-symlink-p file) "-lL" "-l")
|
|
|
7537 file)))
|
|
|
7538 (princ "\nAUTO SAVE FILE on the ")
|
|
|
7539 (if file-name-parsed
|
|
|
7540 (progn
|
|
|
7541 (princ (format "host %s:\n"
|
|
|
7542 (car file-name-parsed)))
|
|
|
7543 (princ
|
|
|
7544 (efs-ls file-name
|
|
|
7545 (if (file-symlink-p file-name) "-lL" "-l")
|
|
|
7546 t t)))
|
|
|
7547 (princ "local host:\n")
|
|
|
7548 (let ((default-directory exec-directory))
|
|
|
7549 (call-process "ls" nil standard-output nil
|
|
|
7550 "-l" file-name)))
|
|
|
7551 (princ "\nFile modification times are given in ")
|
|
|
7552 (princ "the local time of each host.\n"))
|
|
|
7553 (save-excursion
|
|
|
7554 (set-buffer "*Directory*")
|
|
|
7555 (goto-char (point-min))
|
|
|
7556 (while (not (eobp))
|
|
|
7557 (end-of-line)
|
|
|
7558 (if (> (current-column) (window-width))
|
|
|
7559 (progn
|
|
|
7560 (skip-chars-backward " \t")
|
|
|
7561 (skip-chars-backward "^ \t\n")
|
|
|
7562 (if (> (current-column) 12)
|
|
|
7563 (progn
|
|
|
7564 (delete-horizontal-space)
|
|
|
7565 (insert "\n ")))))
|
|
|
7566 (forward-line 1))
|
|
|
7567 (set-buffer-modified-p nil)
|
|
|
7568 (goto-char (point-min)))))
|
|
|
7569 (yes-or-no-p (format "Recover using this auto save file? ")))
|
|
|
7570 (switch-to-buffer (find-file-noselect file t))
|
|
|
7571 (let ((buffer-read-only nil))
|
|
|
7572 (erase-buffer)
|
|
|
7573 (insert-file-contents file-name nil))
|
|
|
7574 (after-find-file nil))
|
|
|
7575 (t (error "Recover-file cancelled."))))
|
|
|
7576 ;; This is no longer done in V19. However, I like the caution for
|
|
|
7577 ;; remote files, where file-newer-than-file-p may lie.
|
|
|
7578 (setq buffer-auto-save-file-name nil)
|
|
|
7579 (message "Auto-save off in this buffer till you do M-x auto-save-mode."))
|
|
|
7580
|
|
|
7581 ;;;; ------------------------------------------------------------------
|
|
|
7582 ;;;; Attributes of files.
|
|
|
7583 ;;;; ------------------------------------------------------------------
|
|
|
7584
|
|
|
7585 (defun efs-file-symlink-p (file)
|
|
|
7586 ;; Version of file-symlink-p for remote files.
|
|
|
7587 ;; Call efs-expand-file-name rather than the normal
|
|
|
7588 ;; expand-file-name to stop loops when using a package that
|
|
|
7589 ;; redefines both file-symlink-p and expand-file-name.
|
|
|
7590 ;; Do not use efs-get-file-entry, because a child-lookup won't do.
|
|
|
7591 (let* ((file (efs-expand-file-name file))
|
|
|
7592 (ignore-case (memq (efs-host-type (car (efs-ftp-path file)))
|
|
|
7593 efs-case-insensitive-host-types))
|
|
|
7594 (file-type (car (efs-get-hash-entry
|
|
|
7595 (efs-get-file-part file)
|
|
|
7596 (efs-get-files (file-name-directory file))
|
|
|
7597 ignore-case))))
|
|
|
7598 (and (stringp file-type)
|
|
|
7599 (if (file-name-absolute-p file-type)
|
|
|
7600 (efs-replace-path-component file file-type)
|
|
|
7601 file-type))))
|
|
|
7602
|
|
|
7603 (defun efs-file-exists-p (path)
|
|
|
7604 ;; file-exists-p for remote file. Uses the cache if possible.
|
|
|
7605 (let* ((path (expand-file-name path))
|
|
|
7606 (parsed (efs-ftp-path path)))
|
|
|
7607 (efs-internal-file-exists-p (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7608 path)))
|
|
|
7609
|
|
|
7610 (efs-defun efs-internal-file-exists-p nil (path)
|
|
|
7611 (and (efs-get-file-entry path) t))
|
|
|
7612
|
|
|
7613 (defun efs-file-directory-p (file)
|
|
|
7614 (let* ((file (expand-file-name file))
|
|
|
7615 (parsed (efs-ftp-path file)))
|
|
|
7616 (efs-internal-file-directory-p (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7617 file)))
|
|
|
7618
|
|
|
7619 (efs-defun efs-internal-file-directory-p nil (path)
|
|
|
7620 ;; Version of file-directory-p for remote files.
|
|
|
7621 (let ((parsed (efs-ftp-path path)))
|
|
|
7622 (or (string-equal (nth 2 parsed) "/") ; root is always a directory
|
|
|
7623 (let ((file-ent (car (efs-get-file-entry
|
|
|
7624 (efs-internal-file-name-as-directory
|
|
|
7625 (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7626 path)))))
|
|
|
7627 ;; We do a file-name-as-directory on path here because some
|
|
|
7628 ;; machines (VMS) use a .DIR to indicate the filename associated
|
|
|
7629 ;; with a directory. This needs to be canonicalized.
|
|
|
7630 (if (stringp file-ent)
|
|
|
7631 (efs-internal-file-directory-p
|
|
|
7632 nil
|
|
|
7633 (efs-chase-symlinks
|
|
|
7634 ;; efs-internal-directory-file-name
|
|
|
7635 ;; only loses for paths where the remote file
|
|
|
7636 ;; is /. This has been eliminated.
|
|
|
7637 (efs-internal-directory-file-name path)))
|
|
|
7638 file-ent)))))
|
|
|
7639
|
|
|
7640 (defun efs-file-attributes (file)
|
|
|
7641 ;; Returns file-file-attributes for a remote file.
|
|
|
7642 ;; For the file modtime does not return efs's cached value, as that
|
|
|
7643 ;; corresponds to buffer-file-modtime (i.e. the modtime of the file
|
|
|
7644 ;; the last time the buffer was vsisted or saved). Caching modtimes
|
|
|
7645 ;; does not make much sense, as they are usually used to determine
|
|
|
7646 ;; if a cache is stale. The modtime if a remote file can be obtained with
|
|
|
7647 ;; efs-get-file-mdtm. This is _not_ returned for the 5th entry here,
|
|
|
7648 ;; because it requires an FTP transaction, and a priori we don't know
|
|
|
7649 ;; if the caller actually cares about this info. Having file-attributes
|
|
|
7650 ;; return such a long list of info is not well suited to remote files,
|
|
|
7651 ;; as some of this info may be costly to obtain.
|
|
|
7652 (let* ((file (expand-file-name file))
|
|
|
7653 (ent (efs-get-file-entry file)))
|
|
|
7654 (if ent
|
|
|
7655 (let* ((parsed (efs-ftp-path file))
|
|
|
7656 (host (nth 0 parsed))
|
|
|
7657 (user (nth 1 parsed))
|
|
|
7658 (path (nth 2 parsed))
|
|
|
7659 (type (car ent))
|
|
|
7660 (size (or (nth 1 ent) -1))
|
|
|
7661 (owner (nth 2 ent))
|
|
|
7662 (modes (nth 3 ent))
|
|
|
7663 ;; Hack to give remote files a "unique" "inode number".
|
|
|
7664 ;; It's actually the sum of the characters in its name.
|
|
|
7665 ;; It's not even really unique.
|
|
|
7666 (inode (apply '+
|
|
|
7667 (nconc (mapcar 'identity host)
|
|
|
7668 (mapcar 'identity user)
|
|
|
7669 (mapcar 'identity
|
|
|
7670 (efs-internal-directory-file-name
|
|
|
7671 path)))))
|
|
|
7672 (nlinks (or (nth 4 ent) -1))) ; return -1 if we don't know
|
|
|
7673 (list
|
|
|
7674 (if (and (stringp type) (file-name-absolute-p type))
|
|
|
7675 (efs-replace-path-component file type)
|
|
|
7676 type) ;0 file type
|
|
|
7677 nlinks ;1 link count
|
|
|
7678 (if owner ;2 uid
|
|
|
7679 ;; Not really a unique integer,
|
|
|
7680 ;; just a half-hearted attempt
|
|
|
7681 (apply '+ (mapcar 'identity owner))
|
|
|
7682 -1)
|
|
|
7683 -1 ;3 gid
|
|
|
7684 '(0 0) ;4 atime
|
|
|
7685 '(0 0) ;5 mtime
|
|
|
7686 '(0 0) ;6 ctime
|
|
|
7687 size ;7 size
|
|
|
7688 (or modes ;8 mode
|
|
|
7689 (concat
|
|
|
7690 (cond ((stringp type) "l")
|
|
|
7691 (type "d")
|
|
|
7692 (t "-"))
|
|
|
7693 "?????????"))
|
|
|
7694 nil ;9 gid weird (Who knows if the gid
|
|
|
7695 ; would be changed?)
|
|
|
7696 inode ;10 inode
|
|
|
7697 -1 ;11 device number [v19 only]
|
|
|
7698 )))))
|
|
|
7699
|
|
|
7700 (defun efs-file-writable-p (file)
|
|
|
7701 ;; file-writable-p for remote files.
|
|
|
7702 ;; Does not attempt to open the file, but just looks at the cached file
|
|
|
7703 ;; modes.
|
|
|
7704 (let* ((file (expand-file-name file))
|
|
|
7705 (ent (efs-get-file-entry file)))
|
|
|
7706 (if (and ent (or (not (stringp (car ent)))
|
|
|
7707 (setq file (efs-chase-symlinks file)
|
|
|
7708 ent (efs-get-file-entry file))))
|
|
|
7709 (let* ((owner (nth 2 ent))
|
|
|
7710 (modes (nth 3 ent))
|
|
|
7711 (parsed (efs-ftp-path file))
|
|
|
7712 (host-type (efs-host-type (car parsed)))
|
|
|
7713 (user (nth 1 parsed)))
|
|
|
7714 (if (memq host-type efs-unix-host-types)
|
|
|
7715 (setq host-type 'unix))
|
|
|
7716 (efs-internal-file-writable-p host-type user owner modes))
|
|
|
7717 (let ((dir (file-name-directory file)))
|
|
|
7718 (and
|
|
|
7719 (not (string-equal dir file))
|
|
|
7720 (file-directory-p dir)
|
|
|
7721 (file-writable-p dir))))))
|
|
|
7722
|
|
|
7723 (efs-defun efs-internal-file-writable-p nil (user owner modes)
|
|
|
7724 ;; By default, we'll just guess yes.
|
|
|
7725 t)
|
|
|
7726
|
|
|
7727 (efs-defun efs-internal-file-writable-p unix (user owner modes)
|
|
|
7728 (if (and modes
|
|
|
7729 (not (string-equal user "root")))
|
|
|
7730 (null
|
|
|
7731 (null
|
|
|
7732 (if (string-equal user owner)
|
|
|
7733 (memq ?w (list (aref modes 2) (aref modes 5)
|
|
|
7734 (aref modes 8)))
|
|
|
7735 (memq ?w (list (aref modes 5) (aref modes 8))))))
|
|
|
7736 t)) ; guess
|
|
|
7737
|
|
|
7738 (defun efs-file-readable-p (file)
|
|
|
7739 ;; Version of file-readable-p that works for remote files.
|
|
|
7740 ;; Works by checking efs's cache of the file modes.
|
|
|
7741 (let* ((file (expand-file-name file))
|
|
|
7742 (ent (efs-get-file-entry file)))
|
|
|
7743 (and ent
|
|
|
7744 (or (not (stringp (car ent)))
|
|
|
7745 (setq ent (efs-get-file-entry (efs-chase-symlinks file))))
|
|
|
7746 ;; file exists
|
|
|
7747 (let* ((parsed (efs-ftp-path file))
|
|
|
7748 (owner (nth 2 ent))
|
|
|
7749 (modes (nth 3 ent))
|
|
|
7750 (host-type (efs-host-type (car parsed)))
|
|
|
7751 (user (nth 1 parsed)))
|
|
|
7752 (if (memq host-type efs-unix-host-types)
|
|
|
7753 (setq host-type 'unix))
|
|
|
7754 (efs-internal-file-readable-p host-type user owner modes)))))
|
|
|
7755
|
|
|
7756 (efs-defun efs-internal-file-readable-p nil (user owner modes)
|
|
|
7757 ;; Guess t by default
|
|
|
7758 t)
|
|
|
7759
|
|
|
7760 (efs-defun efs-internal-file-readable-p unix (user owner modes)
|
|
|
7761 (if (and modes
|
|
|
7762 (not (string-equal user "root")))
|
|
|
7763 (null
|
|
|
7764 (null
|
|
|
7765 (if (string-equal user owner)
|
|
|
7766 (memq ?r (list (aref modes 1) (aref modes 4)
|
|
|
7767 (aref modes 7)))
|
|
|
7768 (memq ?r (list (aref modes 4) (aref modes 7))))))
|
|
|
7769 t)) ; guess
|
|
|
7770
|
|
|
7771 (defun efs-file-executable-p (file)
|
|
|
7772 ;; Version of file-executable-p for remote files.
|
|
|
7773 (let ((ent (efs-get-file-entry file)))
|
|
|
7774 (and ent
|
|
|
7775 (or (not (stringp (car ent)))
|
|
|
7776 (setq ent (efs-get-file-entry (efs-chase-symlinks file))))
|
|
|
7777 ;; file exists
|
|
|
7778 (let* ((parsed (efs-ftp-path file))
|
|
|
7779 (owner (nth 2 ent))
|
|
|
7780 (modes (nth 3 ent))
|
|
|
7781 (host-type (efs-host-type (car parsed)))
|
|
|
7782 (user (nth 1 parsed)))
|
|
|
7783 (if (memq host-type efs-unix-host-types)
|
|
|
7784 (setq host-type 'unix))
|
|
|
7785 (efs-internal-file-executable-p host-type user owner modes)))))
|
|
|
7786
|
|
|
7787 (efs-defun efs-internal-file-executable-p nil (user owner modes)
|
|
|
7788 ;; Guess t by default
|
|
|
7789 t)
|
|
|
7790
|
|
|
7791 (efs-defun efs-internal-file-executable-p unix (user owner modes)
|
|
|
7792 (if (and modes
|
|
|
7793 (not (string-equal user "root")))
|
|
|
7794 (null
|
|
|
7795 (null
|
|
|
7796 (if (string-equal user owner)
|
|
|
7797 (memq ?x (list (aref modes 3) (aref modes 6)
|
|
|
7798 (aref modes 9)))
|
|
|
7799 (memq ?x (list (aref modes 6) (aref modes 9))))))
|
|
|
7800 t)) ; guess
|
|
|
7801
|
|
|
7802 (defun efs-file-accessible-directory-p (dir)
|
|
|
7803 ;; Version of file-accessible-directory-p for remote directories.
|
|
|
7804 (let ((file (directory-file-name dir)))
|
|
|
7805 (and (efs-file-directory-p file) (efs-file-executable-p file))))
|
|
|
7806
|
|
|
7807 ;;;; --------------------------------------------------------------
|
|
|
7808 ;;;; Listing directories.
|
|
|
7809 ;;;; --------------------------------------------------------------
|
|
|
7810
|
|
|
7811 (defun efs-shell-regexp-to-regexp (regexp)
|
|
|
7812 ;; Converts a shell regexp to an emacs regexp.
|
|
|
7813 ;; Probably full of bugs. Tries to follow csh globbing.
|
|
|
7814 (let ((curly 0)
|
|
|
7815 backslash)
|
|
|
7816 (concat "^"
|
|
|
7817 (mapconcat
|
|
|
7818 (function
|
|
|
7819 (lambda (char)
|
|
|
7820 (cond
|
|
|
7821 (backslash
|
|
|
7822 (setq backslash nil)
|
|
|
7823 (regexp-quote (char-to-string char)))
|
|
|
7824 ((and (> curly 0) (eq char ?,))
|
|
|
7825 "\\|")
|
|
|
7826 ((memq char '(?[ ?]))
|
|
|
7827 (char-to-string char))
|
|
|
7828 ((eq char ??)
|
|
|
7829 ".")
|
|
|
7830 ((eq char ?\\)
|
|
|
7831 (setq backslash t)
|
|
|
7832 "")
|
|
|
7833 ((eq char ?*)
|
|
|
7834 ".*")
|
|
|
7835 ((eq char ?{)
|
|
|
7836 (setq curly (1+ curly))
|
|
|
7837 "\\(")
|
|
|
7838 ((and (eq char ?}) (> curly 0))
|
|
|
7839 (setq curly (1- curly))
|
|
|
7840 "\\)")
|
|
|
7841 (t (regexp-quote (char-to-string char))))))
|
|
|
7842 regexp nil)
|
|
|
7843 "$")))
|
|
|
7844
|
|
|
7845
|
|
|
7846 ;;; Getting directory listings.
|
|
|
7847
|
|
|
7848 (defun efs-directory-files (directory &optional full match nosort)
|
|
|
7849 ;; Returns directory-files for remote directories.
|
|
|
7850 ;; NOSORT is a V19 arg.
|
|
|
7851 (let* ((directory (expand-file-name directory))
|
|
|
7852 (parsed (efs-ftp-path directory))
|
|
|
7853 (directory (efs-internal-file-name-as-directory
|
|
|
7854 (efs-host-type (car parsed) (nth 1 parsed)) directory))
|
|
|
7855 files)
|
|
|
7856 (efs-barf-if-not-directory directory)
|
|
|
7857 (setq files (efs-hash-table-keys (efs-get-files directory) nosort))
|
|
|
7858 (cond
|
|
|
7859 ((null (or full match))
|
|
|
7860 files)
|
|
|
7861 (match ; this is slow case
|
|
|
7862 (let (res f)
|
|
|
7863 (efs-save-match-data
|
|
|
7864 (while files
|
|
|
7865 (setq f (if full (concat directory (car files)) (car files))
|
|
|
7866 files (cdr files))
|
|
|
7867 (if (string-match match f)
|
|
|
7868 (setq res (nconc res (list f))))))
|
|
|
7869 res))
|
|
|
7870 (full
|
|
|
7871 (mapcar (function
|
|
|
7872 (lambda (fn)
|
|
|
7873 (concat directory fn)))
|
|
|
7874 files)))))
|
|
|
7875
|
|
|
7876 (defun efs-list-directory (dirname &optional verbose)
|
|
|
7877 ;; Version of list-directory for remote directories.
|
|
|
7878 ;; If verbose is nil, it gets its information from efs's
|
|
|
7879 ;; internal cache.
|
|
|
7880 (let* ((dirname (expand-file-name (or dirname default-directory)))
|
|
|
7881 header)
|
|
|
7882 (if (file-directory-p dirname)
|
|
|
7883 (setq dirname (file-name-as-directory dirname)))
|
|
|
7884 (setq header dirname)
|
|
|
7885 (with-output-to-temp-buffer "*Directory*"
|
|
|
7886 (buffer-disable-undo standard-output)
|
|
|
7887 (princ "Directory ")
|
|
|
7888 (princ header)
|
|
|
7889 (terpri)
|
|
|
7890 (princ
|
|
|
7891 (efs-ls dirname (if verbose
|
|
|
7892 list-directory-verbose-switches
|
|
|
7893 list-directory-brief-switches)
|
|
|
7894 t)))))
|
|
|
7895
|
|
|
7896 ;;;; -------------------------------------------------------------------
|
|
|
7897 ;;;; Manipulating buffers.
|
|
|
7898 ;;;; -------------------------------------------------------------------
|
|
|
7899
|
|
|
7900 (defun efs-get-file-buffer (file)
|
|
|
7901 ;; Version of get-file-buffer for remote files. Needs to fuss over things
|
|
|
7902 ;; like OS's which are case-insens. for file names.
|
|
|
7903 (let ((file (efs-canonize-file-name (expand-file-name file)))
|
|
|
7904 (buff-list (buffer-list))
|
|
|
7905 buff-name)
|
|
|
7906 (catch 'match
|
|
|
7907 (while buff-list
|
|
|
7908 (and (setq buff-name (buffer-file-name (car buff-list)))
|
|
|
7909 (= (length buff-name) (length file)) ; efficiency hack
|
|
|
7910 (string-equal (efs-canonize-file-name buff-name) file)
|
|
|
7911 (throw 'match (car buff-list)))
|
|
|
7912 (setq buff-list (cdr buff-list))))))
|
|
|
7913
|
|
|
7914 (defun efs-create-file-buffer (filename)
|
|
|
7915 ;; Version of create-file-buffer for remote file names.
|
|
|
7916 (let* ((parsed (efs-ftp-path (expand-file-name filename)))
|
|
|
7917 (file (nth 2 parsed))
|
|
|
7918 (host (car parsed))
|
|
|
7919 (host-type (efs-host-type host))
|
|
|
7920 (buff (cond
|
|
|
7921 ((null efs-fancy-buffer-names)
|
|
|
7922 (if (string-equal file "/")
|
|
|
7923 "/"
|
|
|
7924 (efs-internal-file-name-nondirectory
|
|
|
7925 (efs-internal-directory-file-name file))))
|
|
|
7926 ((stringp efs-fancy-buffer-names)
|
|
|
7927 (format efs-fancy-buffer-names
|
|
|
7928 (if (string-equal file "/")
|
|
|
7929 "/"
|
|
|
7930 (efs-internal-file-name-nondirectory
|
|
|
7931 (efs-internal-directory-file-name file)))
|
|
|
7932 (substring host 0 (string-match "\\." host 1))))
|
|
|
7933 (t ; efs-fancy-buffer-names had better be a function
|
|
|
7934 (funcall efs-fancy-buffer-names host
|
|
|
7935 (nth 1 parsed) file)))))
|
|
|
7936 (if (memq host-type efs-case-insensitive-host-types)
|
|
|
7937 (cond ((eq efs-buffer-name-case 'down)
|
|
|
7938 (setq buff (downcase buff)))
|
|
|
7939 ((eq efs-buffer-name-case 'up)
|
|
|
7940 (setq buff (upcase buff)))))
|
|
|
7941 (get-buffer-create (generate-new-buffer-name buff))))
|
|
|
7942
|
|
|
7943 (defun efs-set-buffer-mode ()
|
|
|
7944 "Set correct modes for the current buffer if it is visiting a remote file."
|
|
|
7945 (if (and (stringp buffer-file-name)
|
|
|
7946 (efs-ftp-path buffer-file-name))
|
|
|
7947 (progn
|
|
|
7948 (auto-save-mode efs-auto-save)
|
|
|
7949 (set (make-local-variable 'revert-buffer-function)
|
|
|
7950 'efs-revert-buffer)
|
|
|
7951 (set (make-local-variable 'default-directory-function)
|
|
|
7952 'efs-default-dir-function))))
|
|
|
7953
|
|
|
7954 ;;;; ---------------------------------------------------------
|
|
|
7955 ;;;; Functions for doing backups.
|
|
|
7956 ;;;; ---------------------------------------------------------
|
|
|
7957
|
|
|
7958 (defun efs-backup-buffer ()
|
|
|
7959 ;; Version of backup-buffer for buffers visiting remote files.
|
|
|
7960 (if efs-make-backup-files
|
|
|
7961 (let* ((parsed (efs-ftp-path buffer-file-name))
|
|
|
7962 (host (car parsed))
|
|
|
7963 (host-type (efs-host-type (car parsed))))
|
|
|
7964 (if (or (not (listp efs-make-backup-files))
|
|
|
7965 (memq host-type efs-make-backup-files))
|
|
|
7966 (efs-internal-backup-buffer
|
|
|
7967 host host-type (nth 1 parsed) (nth 2 parsed))))))
|
|
|
7968
|
|
|
7969 (defun efs-internal-backup-buffer (host host-type user remote-path)
|
|
|
7970 ;; This is almost a copy of the function in files.el, modified
|
|
|
7971 ;; to check to see if the backup file exists, before deleting it.
|
|
|
7972 ;; It also supports efs-backup-by-copying, and tries to do the
|
|
|
7973 ;; right thing about backup-by-copying-when-mismatch. Only called
|
|
|
7974 ;; for remote files.
|
|
|
7975 ;; Set the umask now, so that `setmodes' knows about it.
|
|
|
7976 (efs-set-umask host user)
|
|
|
7977 (let ((ent (efs-get-file-entry (expand-file-name buffer-file-name)))
|
|
|
7978 ;; Never do version-control if the remote operating system is doing it.
|
|
|
7979 (version-control (if (memq host-type efs-version-host-types)
|
|
|
7980 'never
|
|
|
7981 version-control))
|
|
|
7982 modstring)
|
|
|
7983 (and make-backup-files
|
|
|
7984 (not buffer-backed-up)
|
|
|
7985 ent ; i.e. file-exists-p
|
|
|
7986 (not (eq t (car ent)))
|
|
|
7987 (or (null (setq modstring (nth 3 ent)))
|
|
|
7988 (not (memq host-type efs-unix-host-types))
|
|
|
7989 (memq (aref modstring 0) '(?- ?l)))
|
|
|
7990 (or (< (length remote-path) 5)
|
|
|
7991 (not (string-equal "/tmp/" (substring remote-path 0 5))))
|
|
|
7992 (condition-case ()
|
|
|
7993 (let* ((backup-info (find-backup-file-name buffer-file-name))
|
|
|
7994 (backupname (car backup-info))
|
|
|
7995 (targets (cdr backup-info))
|
|
|
7996 (links (nth 4 ent))
|
|
|
7997 setmodes)
|
|
|
7998 (condition-case ()
|
|
|
7999 (if (or file-precious-flag
|
|
|
8000 (stringp (car ent)) ; symlinkp
|
|
|
8001 efs-backup-by-copying
|
|
|
8002 (and backup-by-copying-when-linked
|
|
|
8003 links (> links 1))
|
|
|
8004 (and backup-by-copying-when-mismatch
|
|
|
8005 (not
|
|
|
8006 (if (memq
|
|
|
8007 host-type
|
|
|
8008 efs-case-insensitive-host-types)
|
|
|
8009 (string-equal
|
|
|
8010 (downcase user) (downcase (nth 2 ent)))
|
|
|
8011 (string-equal user (nth 2 ent))))))
|
|
|
8012 (copy-file buffer-file-name backupname t t)
|
|
|
8013 (condition-case ()
|
|
|
8014 (if (file-exists-p backupname)
|
|
|
8015 (delete-file backupname))
|
|
|
8016 (file-error nil))
|
|
|
8017 (rename-file buffer-file-name backupname t)
|
|
|
8018 (setq setmodes (file-modes backupname)))
|
|
|
8019 (file-error
|
|
|
8020 ;; If trouble writing the backup, write it in ~.
|
|
|
8021 (setq backupname (expand-file-name "~/%backup%~"))
|
|
|
8022 (message
|
|
|
8023 "Cannot write backup file; backing up in ~/%%backup%%~")
|
|
|
8024 (sleep-for 1)
|
|
|
8025 (copy-file buffer-file-name backupname t t)))
|
|
|
8026 (setq buffer-backed-up t)
|
|
|
8027 ;; Starting with 19.26, trim-versions-without-asking
|
|
|
8028 ;; has been renamed to delete-old-verions.
|
|
|
8029 (if (and targets
|
|
|
8030 (or (if (boundp 'trim-versions-without-asking)
|
|
|
8031 trim-versions-without-asking
|
|
|
8032 (and
|
|
|
8033 (boundp 'delete-old-versions)
|
|
|
8034 delete-old-versions))
|
|
|
8035 (y-or-n-p (format
|
|
|
8036 "Delete excess backup versions of %s? "
|
|
|
8037 buffer-file-name))))
|
|
|
8038 (while targets
|
|
|
8039 (condition-case ()
|
|
|
8040 (delete-file (car targets))
|
|
|
8041 (file-error nil))
|
|
|
8042 (setq targets (cdr targets))))
|
|
|
8043 ;; If the file was already written with the right modes,
|
|
|
8044 ;; don't return set-modes.
|
|
|
8045 (and setmodes
|
|
|
8046 (null
|
|
|
8047 (let ((buff (get-buffer
|
|
|
8048 (efs-ftp-process-buffer host user))))
|
|
|
8049 (and buff
|
|
|
8050 (save-excursion
|
|
|
8051 (set-buffer buff)
|
|
|
8052 (and (integerp efs-process-umask)
|
|
|
8053 (= (efs-modes-from-umask efs-process-umask)
|
|
|
8054 setmodes))))))
|
|
|
8055 setmodes))
|
|
|
8056 (file-error nil)))))
|
|
|
8057
|
|
|
8058 ;;;; ------------------------------------------------------------
|
|
|
8059 ;;;; Redefinition for Emacs file mode support
|
|
|
8060 ;;;; ------------------------------------------------------------
|
|
|
8061
|
|
|
8062 (defmacro efs-build-mode-string-element (int suid-p sticky-p)
|
|
|
8063 ;; INT is between 0 and 7.
|
|
|
8064 ;; If SUID-P is non-nil, we are building the 3-char string for either
|
|
|
8065 ;; the owner or group, and the s[ug]id bit is set.
|
|
|
8066 ;; If STICKY-P is non-nil, we are building the string for other perms,
|
|
|
8067 ;; and the sticky bit is set.
|
|
|
8068 ;; It doesn't make sense for both SUID-P and STICKY-P be non-nil!
|
|
|
8069 (` (let* ((int (, int))
|
|
|
8070 (suid-p (, suid-p))
|
|
|
8071 (sticky-p (, sticky-p))
|
|
|
8072 (read-bit (if (memq int '(4 5 6 7)) "r" "-"))
|
|
|
8073 (write-bit (if (memq int '(2 3 6 7)) "w" "-"))
|
|
|
8074 (x-bit (if (memq int '(1 3 5 7))
|
|
|
8075 (cond (suid-p "s") (sticky-p "t") ("x"))
|
|
|
8076 (cond (suid-p "S") (sticky-p "T") ("-")))))
|
|
|
8077 (concat read-bit write-bit x-bit))))
|
|
|
8078
|
|
|
8079 (defun efs-mode-string (int)
|
|
|
8080 ;; Takes an octal integer between 0 and 7777, and returns the 9 character
|
|
|
8081 ;; mode string.
|
|
|
8082 (let* ((other-int (% int 10))
|
|
|
8083 (int (/ int 10))
|
|
|
8084 (group-int (% int 10))
|
|
|
8085 (int (/ int 10))
|
|
|
8086 (owner-int (% int 10))
|
|
|
8087 (int (/ int 10))
|
|
|
8088 (suid (memq int '(4 5 6 7)))
|
|
|
8089 (sgid (memq int '(2 3 6 7)))
|
|
|
8090 (sticky (memq int '(1 3 5 7))))
|
|
|
8091 (concat (efs-build-mode-string-element owner-int suid nil)
|
|
|
8092 (efs-build-mode-string-element group-int sgid nil)
|
|
|
8093 (efs-build-mode-string-element other-int nil sticky))))
|
|
|
8094
|
|
|
8095 (defun efs-set-file-modes (file mode)
|
|
|
8096 ;; set-file-modes for remote files.
|
|
|
8097 ;; For remote files, if mode is nil, does nothing.
|
|
|
8098 ;; This is because efs-file-modes returns nil if the modes
|
|
|
8099 ;; of a remote file couldn't be determined, even if the file exists.
|
|
|
8100 (and mode
|
|
|
8101 (let* ((file (expand-file-name file))
|
|
|
8102 (parsed (efs-ftp-path file))
|
|
|
8103 (host (car parsed))
|
|
|
8104 (user (nth 1 parsed))
|
|
|
8105 (r-file (nth 2 parsed))
|
|
|
8106 ;; convert to octal, and keep only 12 lowest order bits.
|
|
|
8107 (omode (format "%o" (- mode (lsh (lsh mode -12) 12)))))
|
|
|
8108 (if (or (efs-get-host-property host 'chmod-failed)
|
|
|
8109 (null (memq (efs-host-type host user) efs-unix-host-types)))
|
|
|
8110 (message "Unable to set file modes for %s to %s." file omode)
|
|
|
8111 (efs-send-cmd
|
|
|
8112 host user
|
|
|
8113 (list 'quote 'site 'chmod omode r-file)
|
|
|
8114 nil nil
|
|
|
8115 (efs-cont (result line cont-lines) (host file r-file omode)
|
|
|
8116 (if result
|
|
|
8117 (progn
|
|
|
8118 (efs-set-host-property host 'chmod-failed t)
|
|
|
8119 (message "CHMOD %s failed for %s on %s." omode r-file host)
|
|
|
8120 (if efs-ding-on-chmod-failure
|
|
|
8121 (progn (ding) (sit-for 1))))
|
|
|
8122 (let ((ent (efs-get-file-entry file)))
|
|
|
8123 (if ent
|
|
|
8124 (let* ((type
|
|
|
8125 (cond
|
|
|
8126 ((null (car ent)) "-")
|
|
|
8127 ((eq (car ent) t) "d")
|
|
|
8128 ((stringp (car ent)) "s")
|
|
|
8129 (t
|
|
|
8130 (error
|
|
|
8131 "Weird error in efs-set-file-modes"))))
|
|
|
8132 (mode-string (concat
|
|
|
8133 type
|
|
|
8134 (efs-mode-string
|
|
|
8135 (string-to-int omode))))
|
|
|
8136 (tail (nthcdr 3 ent)))
|
|
|
8137 (if (consp tail)
|
|
|
8138 (setcar tail mode-string)
|
|
|
8139 (efs-add-file-entry nil file (car ent) (nth 1 ent)
|
|
|
8140 (nth 2 ent) mode-string)))))))
|
|
|
8141 0)))) ; It should be safe to do this NOWAIT = 0
|
|
|
8142 ;; set-file-modes returns nil
|
|
|
8143 nil)
|
|
|
8144
|
|
|
8145 (defmacro efs-parse-mode-element (modes)
|
|
|
8146 ;; Parses MODES, a string of three chars, and returns an integer
|
|
|
8147 ;; between 0 and 7 according to how unix file modes are represented
|
|
|
8148 ;; for chmod.
|
|
|
8149 (` (if (= (length (, modes)) 3)
|
|
|
8150 (let ((list (mapcar
|
|
|
8151 (function (lambda (char)
|
|
|
8152 (if (memq char '( ?- ?S ?T)) 0 1)))
|
|
|
8153 (, modes))))
|
|
|
8154 ;; Convert to octal
|
|
|
8155 (+ (* (car list) 4) (* (nth 1 list) 2) (nth 2 list)))
|
|
|
8156 (error "Can't parse modes %s" (, modes)))))
|
|
|
8157
|
|
|
8158 (defun efs-parse-mode-string (string)
|
|
|
8159 ;; Parse a 9-character mode string, and return what it represents
|
|
|
8160 ;; as a decimal integer.
|
|
|
8161 (let ((owner (efs-parse-mode-element (substring string 0 3)))
|
|
|
8162 (group (efs-parse-mode-element (substring string 3 6)))
|
|
|
8163 (other (efs-parse-mode-element (substring string 6 9)))
|
|
|
8164 (owner-x (elt string 2))
|
|
|
8165 (group-x (elt string 5))
|
|
|
8166 (other-x (elt string 8)))
|
|
|
8167 (+ (* (+ (if (memq owner-x '(?s ?S)) 4 0)
|
|
|
8168 (if (memq group-x '(?s ?S)) 2 0)
|
|
|
8169 (if (memq other-x '(?t ?T)) 1 0))
|
|
|
8170 512)
|
|
|
8171 (* owner 64)
|
|
|
8172 (* group 8)
|
|
|
8173 other)))
|
|
|
8174
|
|
|
8175 (defun efs-file-modes (file)
|
|
|
8176 ;; Version of file-modes for remote files.
|
|
|
8177 ;; Returns nil if the file modes can't be determined, either because
|
|
|
8178 ;; the file doesn't exist, or for any other reason.
|
|
|
8179 (let* ((file (expand-file-name file))
|
|
|
8180 (parsed (efs-ftp-path file)))
|
|
|
8181 (and (memq (efs-host-type (car parsed)) efs-unix-host-types)
|
|
|
8182 ;; Someday we should cache mode strings for non-unix, but they
|
|
|
8183 ;; won't be in unix format. Also, CHMOD doesn't work for non-unix
|
|
|
8184 ;; hosts, so returning this info to emacs is a waste.
|
|
|
8185 (let* ((ent (efs-get-file-entry file))
|
|
|
8186 (modes (nth 3 ent)))
|
|
|
8187 (and modes
|
|
|
8188 (efs-parse-mode-string (substring modes 1)))))))
|
|
|
8189
|
|
|
8190 ;;;; ------------------------------------------------------------
|
|
|
8191 ;;;; Redefinition of Emacs file modtime support.
|
|
|
8192 ;;;; ------------------------------------------------------------
|
|
|
8193
|
|
|
8194 (defun efs-day-number (year month day)
|
|
|
8195 ;; Returns the day number within year of date. Taken from calendar.el,
|
|
|
8196 ;; by Edward Reingold. Thanks.
|
|
|
8197 ;; An explanation of the calculation can be found in PascAlgorithms by
|
|
|
8198 ;; Edward and Ruth Reingold, Scott-Foresman/Little, Brown, 1988.
|
|
|
8199 (let ((day-of-year (+ day (* 31 (1- month)))))
|
|
|
8200 (if (> month 2)
|
|
|
8201 (progn
|
|
|
8202 (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
|
|
|
8203 (if (zerop (% year 4))
|
|
|
8204 (setq day-of-year (1+ day-of-year)))))
|
|
|
8205 day-of-year))
|
|
|
8206
|
|
|
8207 (defun efs-days-elapsed (year month day)
|
|
|
8208 ;; Number of days elapsed since Jan 1, `efs-time-zero'
|
|
|
8209 (+ (efs-day-number year month day) ; days this year
|
|
|
8210 (* 365 (- year efs-time-zero)) ; days in prior years
|
|
|
8211 (- (/ (max (1- year) efs-time-zero) 4)
|
|
|
8212 (/ efs-time-zero 4)) ; leap years
|
|
|
8213 -1 )) ; don't count today
|
|
|
8214
|
|
|
8215 ;; 2^16 = 65536
|
|
|
8216 ;; Use this to avoid overflows
|
|
|
8217
|
|
|
8218 (defun efs-seconds-elapsed (year month day hours minutes seconds)
|
|
|
8219 ;; Computes the seconds elapsed from `efs-time-zero', in emacs'
|
|
|
8220 ;; format of a list of two integers, the first the higher 16-bits,
|
|
|
8221 ;; the second the lower 16-bits.
|
|
|
8222 (let* ((days (efs-days-elapsed year month day))
|
|
|
8223 ;; compute hours
|
|
|
8224 (hours (+ (* 24 days) hours))
|
|
|
8225 (high (lsh hours -16))
|
|
|
8226 (low (- hours (lsh high 16)))
|
|
|
8227 ;; compute minutes
|
|
|
8228 (low (+ (* low 60) minutes))
|
|
|
8229 (carry (lsh low -16))
|
|
|
8230 (high (+ (* high 60) carry))
|
|
|
8231 (low (- low (lsh carry 16)))
|
|
|
8232 ;; compute seconds
|
|
|
8233 (low (+ (* low 60) seconds))
|
|
|
8234 (carry (lsh low -16))
|
|
|
8235 (high (+ (* high 60) carry))
|
|
|
8236 (low (- low (lsh carry 16))))
|
|
|
8237 (list high low)))
|
|
|
8238
|
|
|
8239 (defun efs-parse-mdtime (string)
|
|
|
8240 ;; Parse a string, which is assumed to be the result of an ftp MDTM command.
|
|
|
8241 (efs-save-match-data
|
|
|
8242 (if (string-match efs-mdtm-msgs string)
|
|
|
8243 (efs-seconds-elapsed
|
|
|
8244 (string-to-int (substring string 4 8))
|
|
|
8245 (string-to-int (substring string 8 10))
|
|
|
8246 (string-to-int (substring string 10 12))
|
|
|
8247 (string-to-int (substring string 12 14))
|
|
|
8248 (string-to-int (substring string 14 16))
|
|
|
8249 (string-to-int (substring string 16 18))))))
|
|
|
8250
|
|
|
8251 (defun efs-parse-ctime (string)
|
|
|
8252 ;; Parse STRING which is assumed to be the result of a query over port 37.
|
|
|
8253 ;; Returns the number of seconds since the turn of the century, as a
|
|
|
8254 ;; list of two 16-bit integers.
|
|
|
8255 (and (= (length string) 4)
|
|
|
8256 (list (+ (lsh (aref string 0) 8) (aref string 1))
|
|
|
8257 (+ (lsh (aref string 2) 8) (aref string 3)))))
|
|
|
8258
|
|
|
8259 (defun efs-time-minus (time1 time2)
|
|
|
8260 ;; Subtract 32-bit integers, represented as two 16-bit integers.
|
|
|
8261 (let ((high (- (car time1) (car time2)))
|
|
|
8262 (low (- (nth 1 time1) (nth 1 time2))))
|
|
|
8263 (cond
|
|
|
8264 ((and (< high 0) (> low 0))
|
|
|
8265 (setq high (1+ high)
|
|
|
8266 low (- low 65536)))
|
|
|
8267 ((and (> high 0) (< low 0))
|
|
|
8268 (setq high (1- high)
|
|
|
8269 low (+ 65536 low))))
|
|
|
8270 (list high low)))
|
|
|
8271
|
|
|
8272 (defun efs-time-greater (time1 time2)
|
|
|
8273 ;; Compare two 32-bit integers, each represented as a list of two 16-bit
|
|
|
8274 ;; integers.
|
|
|
8275 (or (> (car time1) (car time2))
|
|
|
8276 (and (= (car time1) (car time2))
|
|
|
8277 (> (nth 1 time1) (nth 1 time2)))))
|
|
|
8278
|
|
|
8279 (defun efs-century-time (host &optional nowait cont)
|
|
|
8280 ;; Treat nil as the local host.
|
|
|
8281 ;; Returns the # of seconds since the turn of the century, according
|
|
|
8282 ;; to the system clock on host.
|
|
|
8283 ;; CONT is called with first arg HOST and second the # of seconds.
|
|
|
8284 (or host (setq host (system-name)))
|
|
|
8285 (efs-set-host-property host 'last-ctime nil)
|
|
|
8286 (efs-set-host-property host 'ctime-cont cont)
|
|
|
8287 (let ((name (format efs-ctime-process-name-format host))
|
|
|
8288 proc)
|
|
|
8289 (condition-case nil (delete-process name) (error nil))
|
|
|
8290 (if (and
|
|
|
8291 (or (efs-save-match-data (string-match efs-local-host-regexp host))
|
|
|
8292 (string-equal host (system-name)))
|
|
|
8293 (setq proc (condition-case nil
|
|
|
8294 (open-network-stream name nil host 37)
|
|
|
8295 (error nil))))
|
|
|
8296 (progn
|
|
|
8297 (set (intern name) "")
|
|
|
8298 (set-process-filter
|
|
|
8299 proc
|
|
|
8300 (function
|
|
|
8301 (lambda (proc string)
|
|
|
8302 (let ((name (process-name proc))
|
|
|
8303 result)
|
|
|
8304 (set (intern name) (concat (symbol-value (intern name))
|
|
|
8305 string))
|
|
|
8306 (setq result (efs-parse-ctime
|
|
|
8307 (symbol-value (intern name))))
|
|
|
8308 (if result
|
|
|
8309 (let* ((host (substring name 11 -1))
|
|
|
8310 (cont (efs-get-host-property host 'ctime-cont)))
|
|
|
8311 (efs-set-host-property host 'last-ctime result)
|
|
|
8312 (condition-case nil (delete-process proc) (error nil))
|
|
|
8313 (if cont
|
|
|
8314 (progn
|
|
|
8315 (efs-set-host-property host 'ctime-cont nil)
|
|
|
8316 (efs-call-cont cont host result)))))))))
|
|
|
8317 (set-process-sentinel
|
|
|
8318 proc
|
|
|
8319 (function
|
|
|
8320 (lambda (proc state)
|
|
|
8321 (let* ((name (process-name proc))
|
|
|
8322 (host (substring name 11 -1))
|
|
|
8323 (cont (efs-get-host-property host 'ctime-cont)))
|
|
|
8324 (makunbound (intern name))
|
|
|
8325 (or (efs-get-host-property host 'last-ctime)
|
|
|
8326 (if cont
|
|
|
8327 (progn
|
|
|
8328 (efs-set-host-property host 'ctime-cont nil)
|
|
|
8329 (efs-call-cont cont host 'failed))))))))
|
|
|
8330 (if nowait
|
|
|
8331 nil
|
|
|
8332 (let ((quit-flag nil)
|
|
|
8333 (inhibit-quit nil))
|
|
|
8334 (while (memq (process-status proc) '(run open))
|
|
|
8335 (accept-process-output)))
|
|
|
8336 (accept-process-output)
|
|
|
8337 (or (efs-get-host-property host 'last-ctime)
|
|
|
8338 'failed)))
|
|
|
8339 (if cont
|
|
|
8340 (progn
|
|
|
8341 (efs-set-host-property host 'ctime-cont nil)
|
|
|
8342 (efs-call-cont cont host 'failed)))
|
|
|
8343 (if nowait nil 'failed))))
|
|
|
8344
|
|
|
8345 (defun efs-clock-difference (host &optional nowait)
|
|
|
8346 ;; clock difference with the local host
|
|
|
8347 (let ((result (efs-get-host-property host 'clock-diff)))
|
|
|
8348 (or
|
|
|
8349 result
|
|
|
8350 (progn
|
|
|
8351 (efs-century-time
|
|
|
8352 host nowait
|
|
|
8353 (efs-cont (host result) (nowait)
|
|
|
8354 (if (eq result 'failed)
|
|
|
8355 (efs-set-host-property host 'clock-diff 'failed)
|
|
|
8356 (efs-century-time
|
|
|
8357 nil nowait
|
|
|
8358 (efs-cont (lhost lresult) (host result)
|
|
|
8359 (if (eq lresult 'failed)
|
|
|
8360 (efs-set-host-property host 'clock-diff 'failed)
|
|
|
8361 (efs-set-host-property host 'clock-diff
|
|
|
8362 (efs-time-minus result lresult))))))))
|
|
|
8363 (and (null nowait)
|
|
|
8364 (or (efs-get-host-property host 'clock-diff)
|
|
|
8365 'failed))))))
|
|
|
8366
|
|
|
8367 (defun efs-get-file-mdtm (host user file path)
|
|
|
8368 "For HOST and USER, return FILE's last modification time.
|
|
|
8369 PATH is the file name in full efs syntax.
|
|
|
8370 Returns a list of two six-digit integers which represent the 16 high order
|
|
|
8371 bits, and 16 low order bits of the number of elapsed seconds since
|
|
|
8372 `efs-time-zero'"
|
|
|
8373 (and (null (efs-get-host-property host 'mdtm-failed))
|
|
|
8374 (let ((result (efs-send-cmd host user (list 'quote 'mdtm file)
|
|
|
8375 (and (eq efs-verbose t)
|
|
|
8376 "Getting modtime")))
|
|
|
8377 parsed)
|
|
|
8378 (if (and (null (car result))
|
|
|
8379 (setq parsed (efs-parse-mdtime (nth 1 result))))
|
|
|
8380 (let ((ent (efs-get-file-entry path)))
|
|
|
8381 (if ent
|
|
|
8382 (setcdr ent (list (nth 1 ent) (nth 2 ent)
|
|
|
8383 (nth 3 ent) (nth 4 ent)
|
|
|
8384 parsed)))
|
|
|
8385 parsed)
|
|
|
8386 (efs-save-match-data
|
|
|
8387 ;; The 550 error is for a nonexistent file. Actually implies
|
|
|
8388 ;; that MDTM works.
|
|
|
8389 (if (string-match "^550 " (nth 1 result))
|
|
|
8390 '(0 0)
|
|
|
8391 (efs-set-host-property host 'mdtm-failed t)
|
|
|
8392 nil))))))
|
|
|
8393
|
|
|
8394 (efs-define-fun efs-set-emacs-bvf-mdtm (buffer mdtm)
|
|
|
8395 ;; Sets cached value for the buffer visited file modtime.
|
|
|
8396 (if (get-buffer buffer)
|
|
|
8397 (save-excursion
|
|
|
8398 (set-buffer buffer)
|
|
|
8399 (let (file-name-handler-alist)
|
|
|
8400 (set-visited-file-modtime mdtm)))))
|
|
|
8401
|
|
|
8402 ;; (defun efs-set-visited-file-modtime (&optional time)
|
|
|
8403 ;; ;; For remote files sets the modtime for a buffer to be that of the
|
|
|
8404 ;; ;; visited file. With arg TIME sets the modtime to TIME. TIME must be a list
|
|
|
8405 ;; ;; of two 16-bit integers.
|
|
|
8406 ;; ;; The function set-visited-file-modtime is for emacs-19. It doesn't
|
|
|
8407 ;; ;; exist in emacs 18. If you're running efs, it will work in emacs 18 for
|
|
|
8408 ;; ;; remote files only.
|
|
|
8409 ;; (if time
|
|
|
8410 ;; (efs-set-emacs-bvf-mdtm (current-buffer) time)
|
|
|
8411 ;; (let* ((path buffer-file-name)
|
|
|
8412 ;; (parsed (efs-ftp-path path))
|
|
|
8413 ;; (host (car parsed))
|
|
|
8414 ;; (user (nth 1 parsed))
|
|
|
8415 ;; (file (nth 2 parsed))
|
|
|
8416 ;; (buffer (current-buffer)))
|
|
|
8417 ;; (if (efs-save-match-data
|
|
|
8418 ;; (and efs-verify-modtime-host-regexp
|
|
|
8419 ;; (string-match efs-verify-modtime-host-regexp host)
|
|
|
8420 ;; (or efs-verify-anonymous-modtime
|
|
|
8421 ;; (not (efs-anonymous-p user)))
|
|
|
8422 ;; (not (efs-get-host-property host 'mdtm-failed))))
|
|
|
8423 ;; (efs-send-cmd
|
|
|
8424 ;; host user (list 'quote 'mdtm file)
|
|
|
8425 ;; nil nil
|
|
|
8426 ;; (efs-cont (result line cont-lines) (host user path buffer)
|
|
|
8427 ;; (let (modtime)
|
|
|
8428 ;; (if (and (null result)
|
|
|
8429 ;; (setq modtime (efs-parse-mdtime line)))
|
|
|
8430 ;; (let ((ent (efs-get-file-entry path)))
|
|
|
8431 ;; (if ent
|
|
|
8432 ;; (setcdr ent (list (nth 1 ent) (nth 2 ent)
|
|
|
8433 ;; (nth 3 ent) (nth 4 ent)
|
|
|
8434 ;; modtime)))
|
|
|
8435 ;; (setq buffer (and (setq buffer (get-buffer buffer))
|
|
|
8436 ;; (buffer-name buffer)))
|
|
|
8437 ;; ;; Beware that since this is happening asynch, the buffer
|
|
|
8438 ;; ;; may have disappeared.
|
|
|
8439 ;; (and buffer (efs-set-emacs-bvf-mdtm buffer modtime)))
|
|
|
8440 ;; (efs-save-match-data
|
|
|
8441 ;; (or (string-match "^550 " line)
|
|
|
8442 ;; (efs-set-host-property host 'mdtm-failed t)))
|
|
|
8443 ;; (efs-set-emacs-bvf-mdtm buffer 0)))) ; store dummy values
|
|
|
8444 ;; 0) ; Always do this NOWAIT = 0
|
|
|
8445 ;; (efs-set-emacs-bvf-mdtm buffer 0))
|
|
|
8446 ;; nil) ; return NIL
|
|
|
8447 ;; ))
|
|
|
8448
|
|
|
8449 (defvar efs-set-modtimes-synchronously nil
|
|
|
8450 "*Whether efs uses a synchronous FTP command to set the visited file modtime.
|
|
|
8451 Setting this variable to non-nil means that efs will set visited file modtimes
|
|
|
8452 synchronously.
|
|
|
8453
|
|
|
8454 Asynchronous setting of visited file modtimes leaves a very small
|
|
|
8455 window where Emacs may fail to detect a super session. However, it gives
|
|
|
8456 faster user access to newly visited files.")
|
|
|
8457
|
|
|
8458
|
|
|
8459 (defun efs-set-visited-file-modtime (&optional time)
|
|
|
8460 ;; For remote files sets the modtime for a buffer to be that of the
|
|
|
8461 ;; visited file. With arg TIME sets the modtime to TIME. TIME must be a list
|
|
|
8462 ;; of two 16-bit integers.
|
|
|
8463 ;; The function set-visited-file-modtime is for emacs-19. It doesn't
|
|
|
8464 ;; exist in emacs 18. If you're running efs, it will work in emacs 18 for
|
|
|
8465 ;; remote files only.
|
|
|
8466 (if time
|
|
|
8467 (efs-set-emacs-bvf-mdtm (current-buffer) time)
|
|
|
8468 (let* ((path buffer-file-name)
|
|
|
8469 (parsed (efs-ftp-path path))
|
|
|
8470 (host (car parsed))
|
|
|
8471 (user (nth 1 parsed))
|
|
|
8472 (file (nth 2 parsed))
|
|
|
8473 (buffer (current-buffer)))
|
|
|
8474 (if (efs-save-match-data
|
|
|
8475 (and efs-verify-modtime-host-regexp
|
|
|
8476 (string-match efs-verify-modtime-host-regexp host)
|
|
|
8477 (or efs-verify-anonymous-modtime
|
|
|
8478 (not (efs-anonymous-p user)))
|
|
|
8479 (not (efs-get-host-property host 'mdtm-failed))))
|
|
|
8480 (progn
|
|
|
8481 (or efs-set-modtimes-synchronously (clear-visited-file-modtime))
|
|
|
8482 (efs-send-cmd
|
|
|
8483 host user (list 'quote 'mdtm file)
|
|
|
8484 nil nil
|
|
|
8485 (efs-cont (result line cont-lines) (host user path buffer)
|
|
|
8486 (let (modtime)
|
|
|
8487 (if (and (null result)
|
|
|
8488 (setq modtime (efs-parse-mdtime line)))
|
|
|
8489 (let ((ent (efs-get-file-entry path)))
|
|
|
8490 (if ent
|
|
|
8491 (setcdr ent (list (nth 1 ent) (nth 2 ent)
|
|
|
8492 (nth 3 ent) (nth 4 ent)
|
|
|
8493 modtime)))
|
|
|
8494 (setq buffer (and (setq buffer (get-buffer buffer))
|
|
|
8495 (buffer-name buffer)))
|
|
|
8496 ;; Beware that since might be happening asynch,
|
|
|
8497 ;; the buffer may have disappeared.
|
|
|
8498 (and buffer (efs-set-emacs-bvf-mdtm buffer modtime)))
|
|
|
8499 (efs-save-match-data
|
|
|
8500 (or (string-match "^550 " line)
|
|
|
8501 (efs-set-host-property host 'mdtm-failed t)))
|
|
|
8502 (efs-set-emacs-bvf-mdtm buffer '(0 0))))) ; store dummy values
|
|
|
8503 (and (null efs-set-modtimes-synchronously) 0)))
|
|
|
8504 (efs-set-emacs-bvf-mdtm buffer '(0 0)))
|
|
|
8505 nil))) ; return NIL
|
|
|
8506
|
|
|
8507 (defun efs-file-newer-than-file-p (file1 file2)
|
|
|
8508 ;; Version of file-newer-than-file-p for remote files.
|
|
|
8509 (let* ((file1 (expand-file-name file1))
|
|
|
8510 (file2 (expand-file-name file2))
|
|
|
8511 (parsed1 (efs-ftp-path file1))
|
|
|
8512 (parsed2 (efs-ftp-path file2))
|
|
|
8513 (host1 (car parsed1))
|
|
|
8514 (host2 (car parsed2))
|
|
|
8515 (user1 (nth 1 parsed1))
|
|
|
8516 (user2 (nth 1 parsed2)))
|
|
|
8517 (cond
|
|
|
8518 ;; If the first file doedn't exist, or is remote but
|
|
|
8519 ;; we're not supposed to check modtimes on it, return nil.
|
|
|
8520 ((or (null (file-exists-p file1))
|
|
|
8521 (and parsed1
|
|
|
8522 (or
|
|
|
8523 (null efs-verify-modtime-host-regexp)
|
|
|
8524 (efs-get-host-property host1 'mdtm-failed)
|
|
|
8525 (not (string-match efs-verify-modtime-host-regexp host1))
|
|
|
8526 (and (null efs-verify-anonymous-modtime)
|
|
|
8527 (efs-anonymous-p user1)))))
|
|
|
8528 nil)
|
|
|
8529 ;; If the same is true for the second file, return t.
|
|
|
8530 ((or (null (file-exists-p file2))
|
|
|
8531 (and parsed2
|
|
|
8532 (or
|
|
|
8533 (null efs-verify-modtime-host-regexp)
|
|
|
8534 (efs-get-host-property host2 'mdtm-failed)
|
|
|
8535 (not (string-match efs-verify-modtime-host-regexp host2))
|
|
|
8536 (and (null efs-verify-anonymous-modtime)
|
|
|
8537 (efs-anonymous-p user2)))))
|
|
|
8538 t)
|
|
|
8539 ;; Calculate modtimes. If we get here, any remote files should
|
|
|
8540 ;; have a file entry.
|
|
|
8541 (t
|
|
|
8542 (let (mod1 mod2 shift1 shift2)
|
|
|
8543 (if parsed1
|
|
|
8544 (let ((ent (efs-get-file-entry file1)))
|
|
|
8545 (setq mod1 (nth 5 ent)
|
|
|
8546 shift1 (efs-clock-difference host1))
|
|
|
8547 (or mod1
|
|
|
8548 (setq mod1 (efs-get-file-mdtm
|
|
|
8549 host1 user1 (nth 2 parsed1) file1))))
|
|
|
8550 (setq mod1 (nth 5 (file-attributes file1))))
|
|
|
8551 (if parsed2
|
|
|
8552 (let ((ent (efs-get-file-entry file2)))
|
|
|
8553 (setq mod2 (nth 5 ent)
|
|
|
8554 shift2 (efs-clock-difference host2))
|
|
|
8555 (or mod2
|
|
|
8556 (setq mod2 (efs-get-file-mdtm
|
|
|
8557 host2 user2 (nth 2 parsed2) file2))))
|
|
|
8558 (setq mod2 (nth 5 (file-attributes file2))))
|
|
|
8559 ;; If we can't compute clock shifts, we act as if we don't
|
|
|
8560 ;; even know the modtime. Should we have more faith in ntp?
|
|
|
8561 (cond
|
|
|
8562 ((or (null mod1) (eq shift1 'failed))
|
|
|
8563 nil)
|
|
|
8564 ((or (null mod2) (eq shift2 'failed))
|
|
|
8565 t)
|
|
|
8566 ;; We get to compute something!
|
|
|
8567 (t
|
|
|
8568 (efs-time-greater
|
|
|
8569 (if shift1 (efs-time-minus mod1 shift1) mod1)
|
|
|
8570 (if shift2 (efs-time-minus mod2 shift2) mod2)))))))))
|
|
|
8571
|
|
|
8572 (defun efs-verify-visited-file-modtime (buff)
|
|
|
8573 ;; Verifies the modtime for buffers visiting remote files.
|
|
|
8574 ;; Won't get called for buffer not visiting any file.
|
|
|
8575 (let ((buff (get-buffer buff)))
|
|
|
8576 (null
|
|
|
8577 (and buff ; return t if no buffer? Need to beware of multi-threading.
|
|
|
8578 (buffer-file-name buff) ; t if no file
|
|
|
8579 (let ((mdtm (save-excursion
|
|
|
8580 (set-buffer buff)
|
|
|
8581 (visited-file-modtime))))
|
|
|
8582 (and
|
|
|
8583 (not (eq mdtm 0))
|
|
|
8584 (not (equal mdtm '(0 0)))
|
|
|
8585 efs-verify-modtime-host-regexp
|
|
|
8586 (let* ((path (buffer-file-name buff))
|
|
|
8587 (parsed (efs-ftp-path path))
|
|
|
8588 (host (car parsed))
|
|
|
8589 (user (nth 1 parsed))
|
|
|
8590 nmdtm)
|
|
|
8591 (and
|
|
|
8592 (null (efs-get-host-property host 'mdtm-failed))
|
|
|
8593 (efs-save-match-data
|
|
|
8594 (string-match
|
|
|
8595 efs-verify-modtime-host-regexp host))
|
|
|
8596 (or efs-verify-anonymous-modtime
|
|
|
8597 (not (efs-anonymous-p user)))
|
|
|
8598 (setq nmdtm (efs-get-file-mdtm host user (nth 2 parsed) path))
|
|
|
8599 (progn
|
|
|
8600 (or (equal nmdtm '(0 0))
|
|
|
8601 (file-exists-p path) ; Make sure that there is an entry.
|
|
|
8602 (null
|
|
|
8603 (efs-get-files
|
|
|
8604 (file-name-directory
|
|
|
8605 (efs-internal-directory-file-name path))))
|
|
|
8606 (efs-add-file-entry
|
|
|
8607 (efs-host-type host) path nil nil nil nil nil nmdtm))
|
|
|
8608 (null (and (eq (cdr mdtm) (nth 1 nmdtm))
|
|
|
8609 (eq (car mdtm) (car nmdtm)))))))))))))
|
|
|
8610
|
|
|
8611 ;;;; -----------------------------------------------------------
|
|
|
8612 ;;;; Redefinition of Emacs file name completion
|
|
|
8613 ;;;; -----------------------------------------------------------
|
|
|
8614
|
|
|
8615 (defmacro efs-set-completion-ignored-pattern ()
|
|
|
8616 ;; Set regexp efs-completion-ignored-pattern
|
|
|
8617 ;; to use for filename completion.
|
|
|
8618 (`
|
|
|
8619 (or (equal efs-completion-ignored-extensions
|
|
|
8620 completion-ignored-extensions)
|
|
|
8621 (setq efs-completion-ignored-extensions
|
|
|
8622 completion-ignored-extensions
|
|
|
8623 efs-completion-ignored-pattern
|
|
|
8624 (mapconcat (function
|
|
|
8625 (lambda (s) (if (stringp s)
|
|
|
8626 (concat (regexp-quote s) "$")
|
|
|
8627 "/"))) ; / never in filename
|
|
|
8628 efs-completion-ignored-extensions
|
|
|
8629 "\\|")))))
|
|
|
8630
|
|
|
8631 (defun efs-file-entry-active-p (sym)
|
|
|
8632 ;; If the file entry is a symlink, returns whether the file pointed to
|
|
|
8633 ;; exists.
|
|
|
8634 ;; Note that DIR is dynamically bound.
|
|
|
8635 (let ((file-type (car (get sym 'val))))
|
|
|
8636 (or (not (stringp file-type))
|
|
|
8637 (file-exists-p (efs-chase-symlinks
|
|
|
8638 (expand-file-name file-type efs-completion-dir))))))
|
|
|
8639
|
|
|
8640 (defun efs-file-entry-not-ignored-p (sym)
|
|
|
8641 ;; If the file entry is not a directory (nor a symlink pointing to a
|
|
|
8642 ;; directory) returns whether the file (or file pointed to by the symlink)
|
|
|
8643 ;; is ignored by completion-ignored-extensions.
|
|
|
8644 (let ((file-type (car (get sym 'val)))
|
|
|
8645 (symname (symbol-name sym)))
|
|
|
8646 (if (stringp file-type)
|
|
|
8647 ;; Maybe file-truename would be better here, but it is very costly
|
|
|
8648 ;; to chase symlinks at every level over FTP.
|
|
|
8649 (let ((file (efs-chase-symlinks (expand-file-name
|
|
|
8650 file-type efs-completion-dir))))
|
|
|
8651 (or (file-directory-p file)
|
|
|
8652 (and (file-exists-p file)
|
|
|
8653 (not (string-match efs-completion-ignored-pattern
|
|
|
8654 symname)))))
|
|
|
8655 (or file-type ; is a directory name
|
|
|
8656 (not (string-match efs-completion-ignored-pattern symname))))))
|
|
|
8657
|
|
|
8658 (defun efs-file-name-all-completions (file dir)
|
|
|
8659 ;; Does file-name-all-completions in remote directories.
|
|
|
8660 (efs-barf-if-not-directory dir)
|
|
|
8661 (let* ((efs-completion-dir (file-name-as-directory (expand-file-name dir)))
|
|
|
8662 (completion-ignore-case
|
|
|
8663 (memq (efs-host-type (car (efs-ftp-path efs-completion-dir)))
|
|
|
8664 efs-case-insensitive-host-types))
|
|
|
8665 (tbl (efs-get-files efs-completion-dir))
|
|
|
8666 (completions
|
|
|
8667 (all-completions file tbl
|
|
|
8668 (function efs-file-entry-active-p))))
|
|
|
8669 ;; see whether each matching file is a directory or not...
|
|
|
8670 (mapcar
|
|
|
8671 ;; Since the entries in completions will match the case
|
|
|
8672 ;; of the entries in tbl, don't need to case-fold
|
|
|
8673 ;; in efs-get-hash-entry below.
|
|
|
8674 (function
|
|
|
8675 (lambda (file)
|
|
|
8676 (let ((ent (car (efs-get-hash-entry file tbl))))
|
|
|
8677 (if (or (eq ent t)
|
|
|
8678 (and (stringp ent)
|
|
|
8679 (file-directory-p (efs-chase-symlinks
|
|
|
8680 (expand-file-name
|
|
|
8681 ent efs-completion-dir)))))
|
|
|
8682 (concat file "/")
|
|
|
8683 file))))
|
|
|
8684 completions)))
|
|
|
8685
|
|
|
8686 (defun efs-file-name-completion (file dir)
|
|
|
8687 ;; Does file name expansion in remote directories.
|
|
|
8688 (efs-barf-if-not-directory dir)
|
|
|
8689 (if (equal file "")
|
|
|
8690 ""
|
|
|
8691 (let* ((efs-completion-dir (file-name-as-directory (expand-file-name dir)))
|
|
|
8692 (completion-ignore-case
|
|
|
8693 (memq (efs-host-type (car (efs-ftp-path efs-completion-dir)))
|
|
|
8694 efs-case-insensitive-host-types))
|
|
|
8695 (tbl (efs-get-files efs-completion-dir)))
|
|
|
8696 (efs-set-completion-ignored-pattern)
|
|
|
8697 (efs-save-match-data
|
|
|
8698 (or (efs-file-name-completion-1
|
|
|
8699 file tbl efs-completion-dir
|
|
|
8700 (function efs-file-entry-not-ignored-p))
|
|
|
8701 (efs-file-name-completion-1
|
|
|
8702 file tbl efs-completion-dir
|
|
|
8703 (function efs-file-entry-active-p)))))))
|
|
|
8704
|
|
|
8705 (defun efs-file-name-completion-1 (file tbl dir predicate)
|
|
|
8706 ;; Internal subroutine for efs-file-name-completion. Do not call this.
|
|
|
8707 (let ((bestmatch (try-completion file tbl predicate)))
|
|
|
8708 (if bestmatch
|
|
|
8709 (if (eq bestmatch t)
|
|
|
8710 (if (file-directory-p (expand-file-name file dir))
|
|
|
8711 (concat file "/")
|
|
|
8712 t)
|
|
|
8713 (if (and (eq (try-completion bestmatch tbl predicate) t)
|
|
|
8714 (file-directory-p
|
|
|
8715 (expand-file-name bestmatch dir)))
|
|
|
8716 (concat bestmatch "/")
|
|
|
8717 bestmatch)))))
|
|
|
8718
|
|
|
8719 ;;;; ----------------------------------------------------------
|
|
|
8720 ;;;; Functions for loading lisp.
|
|
|
8721 ;;;; ----------------------------------------------------------
|
|
|
8722
|
|
|
8723 ;;; jka-load provided ideas here. Thanks, Jay.
|
|
|
8724
|
|
|
8725 (defun efs-load-openp (str suffixes)
|
|
|
8726 ;; Given STR, searches load-path and efs-load-lisp-extensions
|
|
|
8727 ;; for the name of a file to load. Returns the full path, or nil
|
|
|
8728 ;; if none found.
|
|
|
8729 (let ((path-list (if (file-name-absolute-p str) t load-path))
|
|
|
8730 root result)
|
|
|
8731 ;; If there is no load-path, at least try the default directory.
|
|
|
8732 (or path-list
|
|
|
8733 (setq path-list (list default-directory)))
|
|
|
8734 (while (and path-list (null result))
|
|
|
8735 (if (eq path-list t)
|
|
|
8736 (setq path-list nil
|
|
|
8737 root str)
|
|
|
8738 (setq root (expand-file-name str (car path-list))
|
|
|
8739 path-list (cdr path-list))
|
|
|
8740 (or (file-name-absolute-p root)
|
|
|
8741 (setq root (expand-file-name root default-directory))))
|
|
|
8742 (let ((suff-list suffixes))
|
|
|
8743 (while (and suff-list (null result))
|
|
|
8744 (let ((try (concat root (car suff-list))))
|
|
|
8745 (if (or (not (file-readable-p try))
|
|
|
8746 (file-directory-p try))
|
|
|
8747 (setq suff-list (cdr suff-list))
|
|
|
8748 (setq result try))))))
|
|
|
8749 result))
|
|
|
8750
|
|
|
8751 (defun efs-load (file &optional noerror nomessage nosuffix)
|
|
|
8752 "Documented as original."
|
|
|
8753 (let ((filename (efs-load-openp
|
|
|
8754 file
|
|
|
8755 (if nosuffix '("") efs-load-lisp-extensions))))
|
|
|
8756 (if (not filename)
|
|
|
8757 (and (null noerror) (error "Cannot open load file %s" file))
|
|
|
8758 (let ((parsed (efs-ftp-path filename))
|
|
|
8759 (after-load (and (boundp 'after-load-alist)
|
|
|
8760 (assoc file after-load-alist))))
|
|
|
8761 (if parsed
|
|
|
8762 (let ((temp (car (efs-make-tmp-name nil (car parsed)))))
|
|
|
8763 (unwind-protect
|
|
|
8764 (progn
|
|
|
8765 (efs-copy-file-internal
|
|
|
8766 filename parsed temp nil t nil
|
|
|
8767 (format "Getting %s" filename))
|
|
|
8768 (or (file-readable-p temp)
|
|
|
8769 (error
|
|
|
8770 "efs-load: temp file %s is unreadable" temp))
|
|
|
8771 (or nomessage
|
|
|
8772 (message "Loading %s..." file))
|
|
|
8773 ;; temp is an absolute filename, so load path
|
|
|
8774 ;; won't be searched.
|
|
|
8775 (let (after-load-alist)
|
|
|
8776 (efs-real-load temp t t t))
|
|
|
8777 (or nomessage
|
|
|
8778 (message "Loading %s...done" file))
|
|
|
8779 (if after-load (mapcar 'eval (cdr after-load)))
|
|
|
8780 t) ; return t if everything worked
|
|
|
8781 (efs-del-tmp-name temp)))
|
|
|
8782 (prog2
|
|
|
8783 (or nomessage
|
|
|
8784 (message "Loading %s..." file))
|
|
|
8785 (let (after-load-alist)
|
|
|
8786 (or (efs-real-load filename noerror t t)
|
|
|
8787 (setq after-load nil)))
|
|
|
8788 (or nomessage
|
|
|
8789 (message "Loading %s...done" file))
|
|
|
8790 (if after-load (mapcar 'eval (cdr after-load)))))))))
|
|
|
8791
|
|
|
8792 (defun efs-require (feature &optional filename)
|
|
|
8793 "Documented as original."
|
|
|
8794 (if (eq feature 'ange-ftp) (efs-require-scream-and-yell))
|
|
|
8795 (if (featurep feature)
|
|
|
8796 feature
|
|
|
8797 (or filename (setq filename (symbol-name feature)))
|
|
|
8798 (let ((fullpath (efs-load-openp filename
|
|
|
8799 efs-load-lisp-extensions)))
|
|
|
8800 (if (not fullpath)
|
|
|
8801 (error "Cannot open load file: %s" filename)
|
|
|
8802 (let ((parsed (efs-ftp-path fullpath)))
|
|
|
8803 (if parsed
|
|
|
8804 (let ((temp (car (efs-make-tmp-name nil (car parsed)))))
|
|
|
8805 (unwind-protect
|
|
|
8806 (progn
|
|
|
8807 (efs-copy-file-internal
|
|
|
8808 fullpath parsed temp nil t nil
|
|
|
8809 (format "Getting %s" fullpath))
|
|
|
8810 (or (file-readable-p temp)
|
|
|
8811 (error
|
|
|
8812 "efs-require: temp file %s is unreadable" temp))
|
|
|
8813 (efs-real-require feature temp))
|
|
|
8814 (efs-del-tmp-name temp)))
|
|
|
8815 (efs-real-require feature fullpath)))))))
|
|
|
8816
|
|
|
8817 (defun efs-require-scream-and-yell ()
|
|
|
8818 ;; Complain if something attempts to load ange-ftp.
|
|
|
8819 (with-output-to-temp-buffer "*Help*"
|
|
|
8820 (princ
|
|
|
8821 "Something tried to load ange-ftp.
|
|
|
8822 EFS AND ANGE-FTP DO NOT WORK TOGETHER.
|
|
|
8823
|
|
|
8824 If the culprit package does need to access ange-ftp internal functions,
|
|
|
8825 then it should be adequate to simply remove the \(require 'ange-ftp\)
|
|
|
8826 line and let efs handle remote file access. Otherwise, it will need to
|
|
|
8827 be ported to efs. This may already have been done, and you can find out
|
|
|
8828 by sending an enquiry to efs-help@cuckoo.hpl.hp.com.
|
|
|
8829
|
|
|
8830 Signalling an error with backtrace will allow you to determine which
|
|
|
8831 package was requiring ange-ftp.\n"))
|
|
|
8832 (select-window (get-buffer-window "*Help*"))
|
|
|
8833 (enlarge-window (- (count-lines (point-min) (point-max))
|
|
|
8834 (window-height) -1))
|
|
|
8835 (if (y-or-n-p "Signal error with backtrace? ")
|
|
|
8836 (let ((stack-trace-on-error t))
|
|
|
8837 (error "Attempt to require ange-ftp"))))
|
|
|
8838
|
|
|
8839 ;;;; -----------------------------------------------------------
|
|
|
8840 ;;;; Redefinition of Emacs functions for reading file names.
|
|
|
8841 ;;;; -----------------------------------------------------------
|
|
|
8842
|
|
|
8843 (defun efs-unexpand-parsed-filename (host user path)
|
|
|
8844 ;; Replaces the home directory in path with "~". Returns the unexpanded
|
|
|
8845 ;; full-path.
|
|
|
8846 (let* ((path-len (length path))
|
|
|
8847 (def-user (efs-get-user host))
|
|
|
8848 (host-type (efs-host-type host user))
|
|
|
8849 (ignore-case (memq host-type efs-case-insensitive-host-types)))
|
|
|
8850 (if (> path-len 1)
|
|
|
8851 (let* ((home (efs-expand-tilde "~" host-type host user))
|
|
|
8852 (home-len (length home)))
|
|
|
8853 (if (and (> path-len home-len)
|
|
|
8854 (if ignore-case (string-equal (downcase home)
|
|
|
8855 (downcase
|
|
|
8856 (substring path
|
|
|
8857 0 home-len)))
|
|
|
8858 (string-equal home (substring path 0 home-len)))
|
|
|
8859 (= (aref path home-len) ?/))
|
|
|
8860 (setq path (concat "~" (substring path home-len))))))
|
|
|
8861 (if (if ignore-case (string-equal (downcase user)
|
|
|
8862 (downcase def-user))
|
|
|
8863 (string-equal user def-user))
|
|
|
8864 (format efs-path-format-without-user host path)
|
|
|
8865 (format efs-path-format-string user host path))))
|
|
|
8866
|
|
|
8867 (efs-define-fun efs-abbreviate-file-name (filename)
|
|
|
8868 ;; Version of abbreviate-file-name for remote files.
|
|
|
8869 (efs-save-match-data
|
|
|
8870 (let ((tail directory-abbrev-alist))
|
|
|
8871 (while tail
|
|
|
8872 (if (string-match (car (car tail)) filename)
|
|
|
8873 (setq filename
|
|
|
8874 (concat (cdr (car tail))
|
|
|
8875 (substring filename (match-end 0)))))
|
|
|
8876 (setq tail (cdr tail)))
|
|
|
8877 (apply 'efs-unexpand-parsed-filename (efs-ftp-path filename)))))
|
|
|
8878
|
|
|
8879 (defun efs-default-dir-function ()
|
|
|
8880 (let ((parsed (efs-ftp-path default-directory))
|
|
|
8881 (dd default-directory))
|
|
|
8882 (if parsed
|
|
|
8883 (efs-save-match-data
|
|
|
8884 (let ((tail directory-abbrev-alist))
|
|
|
8885 (while tail
|
|
|
8886 (if (string-match (car (car tail)) dd)
|
|
|
8887 (setq dd (concat (cdr (car tail))
|
|
|
8888 (substring dd (match-end 0)))
|
|
|
8889 parsed nil))
|
|
|
8890 (setq tail (cdr tail)))
|
|
|
8891 (apply 'efs-unexpand-parsed-filename
|
|
|
8892 (or parsed (efs-ftp-path dd)))))
|
|
|
8893 default-directory)))
|
|
|
8894
|
|
|
8895 (defun efs-re-read-dir (&optional dir)
|
|
|
8896 "Forces a re-read of the directory DIR.
|
|
|
8897 If DIR is omitted then it defaults to the directory part of the contents
|
|
|
8898 of the current buffer. This is so this function can be caled from the
|
|
|
8899 minibuffer."
|
|
|
8900 (interactive)
|
|
|
8901 (if dir
|
|
|
8902 (setq dir (expand-file-name dir))
|
|
|
8903 (setq dir (file-name-directory (expand-file-name (buffer-string)))))
|
|
|
8904 (let ((parsed (efs-ftp-path dir)))
|
|
|
8905 (if parsed
|
|
|
8906 (let ((efs-ls-uncache t))
|
|
|
8907 (efs-del-hash-entry (efs-canonize-file-name dir)
|
|
|
8908 efs-files-hashtable)
|
|
|
8909 (efs-get-files dir t)))))
|
|
|
8910
|
|
|
8911 ;;;; ---------------------------------------------------------------
|
|
|
8912 ;;;; Creation and deletion of files and directories.
|
|
|
8913 ;;;; ---------------------------------------------------------------
|
|
|
8914
|
|
|
8915 (defun efs-delete-file (file)
|
|
|
8916 ;; Deletes remote files.
|
|
|
8917 (let* ((file (expand-file-name file))
|
|
|
8918 (parsed (efs-ftp-path file))
|
|
|
8919 (host (car parsed))
|
|
|
8920 (user (nth 1 parsed))
|
|
|
8921 (host-type (efs-host-type host user))
|
|
|
8922 (path (nth 2 parsed))
|
|
|
8923 (abbr (efs-relativize-filename file))
|
|
|
8924 (result (efs-send-cmd host user (list 'delete path)
|
|
|
8925 (format "Deleting %s" abbr))))
|
|
|
8926 (if (car result)
|
|
|
8927 (signal 'ftp-error
|
|
|
8928 (list "Removing old name"
|
|
|
8929 (format "FTP Error: \"%s\"" (nth 1 result))
|
|
|
8930 file)))
|
|
|
8931 (efs-delete-file-entry host-type file)))
|
|
|
8932
|
|
|
8933 (defun efs-make-directory-internal (dir)
|
|
|
8934 ;; version of make-directory-internal for remote directories.
|
|
|
8935 (if (file-exists-p dir)
|
|
|
8936 (error "Cannot make directory %s: file already exists" dir)
|
|
|
8937 (let* ((parsed (efs-ftp-path dir))
|
|
|
8938 (host (nth 0 parsed))
|
|
|
8939 (user (nth 1 parsed))
|
|
|
8940 (host-type (efs-host-type host user))
|
|
|
8941 ;; Some ftp's on unix machines (at least on Suns)
|
|
|
8942 ;; insist that mkdir take a filename, and not a
|
|
|
8943 ;; directory-name name as an arg. Argh!! This is a bug.
|
|
|
8944 ;; Non-unix machines will probably always insist
|
|
|
8945 ;; that mkdir takes a directory-name as an arg
|
|
|
8946 ;; (as the ftp man page says it should).
|
|
|
8947 (path (if (or (memq host-type efs-unix-host-types)
|
|
|
8948 (memq host-type '(os2 dos)))
|
|
|
8949 (efs-internal-directory-file-name (nth 2 parsed))
|
|
|
8950 (efs-internal-file-name-as-directory
|
|
|
8951 host-type (nth 2 parsed))))
|
|
|
8952 (abbr (efs-relativize-filename dir))
|
|
|
8953 (result (efs-send-cmd host user
|
|
|
8954 (list 'mkdir path)
|
|
|
8955 (format "Making directory %s"
|
|
|
8956 abbr))))
|
|
|
8957 (if (car result)
|
|
|
8958 (efs-error host user
|
|
|
8959 (format "Could not make directory %s: %s" dir
|
|
|
8960 (nth 1 result))))
|
|
|
8961 (efs-add-file-entry host-type dir t nil user))))
|
|
|
8962
|
|
|
8963 ;; V19 calls this function delete-directory. It used to be called
|
|
|
8964 ;; remove-directory.
|
|
|
8965
|
|
|
8966 (defun efs-delete-directory (dir)
|
|
|
8967 ;; Version of delete-directory for remote directories.
|
|
|
8968 (if (file-directory-p dir)
|
|
|
8969 (let* ((parsed (efs-ftp-path dir))
|
|
|
8970 (host (nth 0 parsed))
|
|
|
8971 (user (nth 1 parsed))
|
|
|
8972 (host-type (efs-host-type host user))
|
|
|
8973 ;; Some ftp's on unix machines (at least on Suns)
|
|
|
8974 ;; insist that rmdir take a filename, and not a
|
|
|
8975 ;; directory-name name as an arg. Argh!! This is a bug.
|
|
|
8976 ;; Non-unix machines will probably always insist
|
|
|
8977 ;; that rmdir takes a directory-name as an arg
|
|
|
8978 ;; (as the ftp man page says it should).
|
|
|
8979 (path
|
|
|
8980 (if (or (memq host-type efs-unix-host-types)
|
|
|
8981 (memq host-type '(os2 dos)))
|
|
|
8982 (efs-internal-directory-file-name (nth 2 parsed))
|
|
|
8983 (efs-internal-file-name-as-directory
|
|
|
8984 host-type (nth 2 parsed))))
|
|
|
8985 (abbr (efs-relativize-filename dir))
|
|
|
8986 (result (efs-send-cmd host user
|
|
|
8987 (list 'rmdir path)
|
|
|
8988 (format "Deleting directory %s" abbr))))
|
|
|
8989 (if (car result)
|
|
|
8990 (efs-error host user
|
|
|
8991 (format "Could not delete directory %s: %s"
|
|
|
8992 dir (nth 1 result))))
|
|
|
8993 (efs-delete-file-entry host-type dir t))
|
|
|
8994 (error "Not a directory: %s" dir)))
|
|
|
8995
|
|
|
8996 (defun efs-file-local-copy (file)
|
|
|
8997 ;; internal function for diff.el (dired 6.3 or later)
|
|
|
8998 ;; Makes a temp file containing the contents of file.
|
|
|
8999 ;; returns the name of the tmp file created, or nil if none is.
|
|
|
9000 ;; This function should have optional cont and nowait args.
|
|
|
9001 (let* ((file (expand-file-name file))
|
|
|
9002 (tmp (car (efs-make-tmp-name nil (car (efs-ftp-path file))))))
|
|
|
9003 (efs-copy-file-internal file (efs-ftp-path file)
|
|
|
9004 tmp nil t nil (format "Getting %s" file))
|
|
|
9005 tmp))
|
|
|
9006
|
|
|
9007 (defun efs-diff/grep-del-temp-file (temp)
|
|
|
9008 ;; internal function for diff.el and grep.el
|
|
|
9009 ;; if TEMP is non-nil, deletes the temp file TEMP.
|
|
|
9010 ;; if TEMP is nil, does nothing.
|
|
|
9011 (and temp
|
|
|
9012 (efs-del-tmp-name temp)))
|
|
|
9013
|
|
|
9014 ;;;; ------------------------------------------------------------
|
|
|
9015 ;;;; File copying support...
|
|
|
9016 ;;;; ------------------------------------------------------------
|
|
|
9017
|
|
|
9018 ;;; - totally re-written 6/24/92.
|
|
|
9019 ;;; - re-written again 9/3/93
|
|
|
9020 ;;; - and again 14/4/93
|
|
|
9021 ;;; - and again 17/8/93
|
|
|
9022
|
|
|
9023 (defun efs-barf-or-query-if-file-exists (absname querystring interactive)
|
|
|
9024 (if (file-exists-p absname)
|
|
|
9025 (if (not interactive)
|
|
|
9026 (signal 'file-already-exists (list absname))
|
|
|
9027 (if (not (yes-or-no-p (format "File %s already exists; %s anyway? "
|
|
|
9028 absname querystring)))
|
|
|
9029 (signal 'file-already-exists (list absname))))))
|
|
|
9030
|
|
|
9031 (defun efs-concatenate-files (file1 file2)
|
|
|
9032 ;; Concatenates file1 to file2. Both must be local files.
|
|
|
9033 ;; Needed because the efs version of copy-file understands
|
|
|
9034 ;; ok-if-already-exists = 'append
|
|
|
9035 (or (file-readable-p file1)
|
|
|
9036 (signal 'file-error
|
|
|
9037 (list (format "Input file %s not readable." file1))))
|
|
|
9038 (or (file-writable-p file2)
|
|
|
9039 (signal 'file-error
|
|
|
9040 (list (format "Output file %s not writable." file2))))
|
|
|
9041 (let ((default-directory exec-directory))
|
|
|
9042 (call-process "sh" nil nil nil "-c" (format "cat %s >> %s" file1 file2))))
|
|
|
9043
|
|
|
9044 (defun efs-copy-add-file-entry (newname host-type user size append)
|
|
|
9045 ;; Add an entry in `efs-files-hashtable' for a file newly created via a copy.
|
|
|
9046 (if (eq size -1) (setq size nil))
|
|
|
9047 (if append
|
|
|
9048 (let ((ent (efs-get-file-entry newname)))
|
|
|
9049 (if (and ent (null (car ent)))
|
|
|
9050 (if (and size (numberp (nth 1 ent)))
|
|
|
9051 (setcar (cdr ent) (+ size (nth 1 ent)))
|
|
|
9052 (setcar (cdr ent) nil))
|
|
|
9053 ;; If the ent is a symlink or directory, don't overwrite that entry.
|
|
|
9054 (if (null ent)
|
|
|
9055 (efs-add-file-entry host-type newname nil nil nil))))
|
|
|
9056 (efs-add-file-entry host-type newname nil size user)))
|
|
|
9057
|
|
|
9058 (defun efs-copy-remote-to-remote (f-host-type f-host f-user f-path filename
|
|
|
9059 t-host-type t-host t-user
|
|
|
9060 t-path newname append msg cont
|
|
|
9061 nowait xfer-type)
|
|
|
9062 ;; Use a 3rd data connection to copy from F-HOST for F-USER to T-HOST
|
|
|
9063 ;; for T-USER.
|
|
|
9064 (if (efs-get-host-property t-host 'pasv-failed)
|
|
|
9065 ;; PASV didn't work before, don't try again.
|
|
|
9066 (if cont (efs-call-cont cont 'failed "" ""))
|
|
|
9067 (or xfer-type
|
|
|
9068 (setq xfer-type (efs-xfer-type f-host-type filename
|
|
|
9069 t-host-type newname)))
|
|
|
9070 (efs-send-cmd
|
|
|
9071 t-host t-user '(quote pasv) nil nil
|
|
|
9072 (efs-cont (pasv-result pasv-line pasv-cont-lines)
|
|
|
9073 (cont nowait f-host-type f-host f-user f-path filename
|
|
|
9074 t-host-type t-host t-user t-path newname xfer-type msg append)
|
|
|
9075 (efs-save-match-data
|
|
|
9076 (if (or pasv-result
|
|
|
9077 (not (string-match efs-pasv-msgs pasv-line)))
|
|
|
9078 (progn
|
|
|
9079 (efs-set-host-property t-host 'pasv-failed t)
|
|
|
9080 (if cont
|
|
|
9081 (efs-call-cont
|
|
|
9082 cont (or pasv-result 'failed) pasv-line pasv-cont-lines)))
|
|
|
9083 (let ((address (substring pasv-line (match-beginning 1)
|
|
|
9084 (match-end 1))))
|
|
|
9085 (efs-send-cmd
|
|
|
9086 f-host f-user
|
|
|
9087 (list 'quote 'port address) nil nil
|
|
|
9088 (efs-cont (port-result port-line port-cont-lines)
|
|
|
9089 (cont f-host f-user f-host-type f-path filename
|
|
|
9090 xfer-type msg)
|
|
|
9091 (if port-result
|
|
|
9092 (if cont
|
|
|
9093 (efs-call-cont
|
|
|
9094 cont port-result port-line port-cont-lines)
|
|
|
9095 (efs-error f-host f-user
|
|
|
9096 (format "PORT failed for %s: %s"
|
|
|
9097 filename port-line)))
|
|
|
9098 (efs-send-cmd
|
|
|
9099 f-host f-user
|
|
|
9100 (list 'quote 'retr f-path xfer-type)
|
|
|
9101 msg nil
|
|
|
9102 (efs-cont (retr-result retr-line retr-cont-lines)
|
|
|
9103 (cont f-host f-user f-path)
|
|
|
9104 (and retr-result
|
|
|
9105 (null cont)
|
|
|
9106 (efs-error
|
|
|
9107 f-host f-user
|
|
|
9108 (format "RETR failed for %s: %s"
|
|
|
9109 f-path retr-line)))
|
|
|
9110 (if cont (efs-call-cont
|
|
|
9111 cont retr-result retr-line retr-cont-lines)))
|
|
|
9112 (if (eq nowait t) 1 nowait))))
|
|
|
9113 1) ; can't ever wait on this command.
|
|
|
9114 (efs-send-cmd
|
|
|
9115 t-host t-user
|
|
|
9116 (list 'quote (if append 'appe 'stor) t-path xfer-type)
|
|
|
9117 nil nil
|
|
|
9118 (efs-cont (stor-result stor-line stor-cont-lines)
|
|
|
9119 (t-host t-user t-path t-host-type newname filename
|
|
|
9120 append)
|
|
|
9121 (if stor-result
|
|
|
9122 (efs-error
|
|
|
9123 t-host t-user (format "%s failed for %s: %s"
|
|
|
9124 (if append "APPE" "STOR")
|
|
|
9125 t-path stor-line))
|
|
|
9126 (efs-copy-add-file-entry
|
|
|
9127 newname t-host-type t-user
|
|
|
9128 (nth 1 (efs-get-file-entry filename)) append)))
|
|
|
9129 (if (eq nowait t) 1 nowait))))))
|
|
|
9130 nowait)))
|
|
|
9131
|
|
|
9132 (defun efs-copy-on-remote (host user host-type filename newname filename-parsed
|
|
|
9133 newname-parsed keep-date append-p msg cont
|
|
|
9134 nowait xfer-type)
|
|
|
9135 ;; Uses site exec to copy the file on a remote host
|
|
|
9136 (let ((exec-cp (efs-get-host-property host 'exec-cp)))
|
|
|
9137 (if (or append-p
|
|
|
9138 (not (memq host-type efs-unix-host-types))
|
|
|
9139 (efs-get-host-property host 'exec-failed)
|
|
|
9140 (eq exec-cp 'failed))
|
|
|
9141 (efs-copy-via-temp filename filename-parsed newname newname-parsed
|
|
|
9142 append-p keep-date msg cont nowait xfer-type)
|
|
|
9143 (if (eq exec-cp 'works)
|
|
|
9144 (efs-send-cmd
|
|
|
9145 host user
|
|
|
9146 (list 'quote 'site 'exec
|
|
|
9147 (format "cp %s%s %s" (if keep-date "-p " "")
|
|
|
9148 (nth 2 filename-parsed) (nth 2 newname-parsed)))
|
|
|
9149 msg nil
|
|
|
9150 (efs-cont (result line cont-lines) (host user filename newname
|
|
|
9151 host-type filename-parsed
|
|
|
9152 newname-parsed
|
|
|
9153 keep-date append-p msg cont
|
|
|
9154 xfer-type nowait)
|
|
|
9155 (if result
|
|
|
9156 (progn
|
|
|
9157 (efs-set-host-property host 'exec-failed t)
|
|
|
9158 (efs-copy-via-temp filename filename-parsed newname
|
|
|
9159 newname-parsed append-p keep-date
|
|
|
9160 nil cont nowait xfer-type))
|
|
|
9161 (efs-save-match-data
|
|
|
9162 (if (string-match "\n200-\\([^\n]*\\)" cont-lines)
|
|
|
9163 (let ((err (substring cont-lines (match-beginning 1)
|
|
|
9164 (match-end 1))))
|
|
|
9165 (if cont
|
|
|
9166 (efs-call-cont cont 'failed err cont-lines)
|
|
|
9167 (efs-error host user err)))
|
|
|
9168 (efs-copy-add-file-entry
|
|
|
9169 newname host-type user
|
|
|
9170 (nth 7 (efs-file-attributes filename)) nil)
|
|
|
9171 (if cont (efs-call-cont cont nil line cont-lines))))))
|
|
|
9172 nowait)
|
|
|
9173 (message "Checking for cp executable on %s..." host)
|
|
|
9174 (efs-send-cmd
|
|
|
9175 host user (list 'quote 'site 'exec "cp / /") nil nil
|
|
|
9176 (efs-cont (result line cont-lines) (host user filename newname
|
|
|
9177 host-type filename-parsed
|
|
|
9178 newname-parsed
|
|
|
9179 keep-date append-p msg cont
|
|
|
9180 xfer-type nowait)
|
|
|
9181 (efs-save-match-data
|
|
|
9182 (if (string-match "\n200-" cont-lines)
|
|
|
9183 (efs-set-host-property host 'exec-cp 'works)
|
|
|
9184 (efs-set-host-property host 'exec-cp 'failed)))
|
|
|
9185 (efs-copy-on-remote host user host-type filename newname
|
|
|
9186 filename-parsed newname-parsed keep-date
|
|
|
9187 append-p msg cont nowait xfer-type))
|
|
|
9188 nowait)))))
|
|
|
9189
|
|
|
9190 (defun efs-copy-via-temp (filename filename-parsed newname newname-parsed
|
|
|
9191 append keep-date msg cont nowait xfer-type)
|
|
|
9192 ;; Copies from FILENAME to NEWNAME via a temp file.
|
|
|
9193 (let* ((temp (car (if (efs-use-gateway-p (car filename-parsed) t)
|
|
|
9194 (efs-make-tmp-name (car filename-parsed)
|
|
|
9195 (car newname-parsed))
|
|
|
9196 (efs-make-tmp-name (car newname-parsed)
|
|
|
9197 (car filename-parsed)))))
|
|
|
9198 (temp-parsed (efs-ftp-path temp)))
|
|
|
9199 (or xfer-type (setq xfer-type
|
|
|
9200 (efs-xfer-type
|
|
|
9201 (efs-host-type (car filename-parsed)) filename
|
|
|
9202 (efs-host-type (car newname-parsed)) newname
|
|
|
9203 t)))
|
|
|
9204 (efs-copy-file-internal
|
|
|
9205 filename filename-parsed temp temp-parsed t nil (if (eq 0 msg) 2 msg)
|
|
|
9206 (efs-cont (result line cont-lines) (newname newname-parsed temp
|
|
|
9207 temp-parsed append msg cont
|
|
|
9208 nowait xfer-type)
|
|
|
9209 (if result
|
|
|
9210 (progn
|
|
|
9211 (efs-del-tmp-name temp)
|
|
|
9212 (if cont
|
|
|
9213 (efs-call-cont cont result line cont-lines)
|
|
|
9214 (signal 'ftp-error
|
|
|
9215 (list "Opening input file"
|
|
|
9216 (format "FTP Error: \"%s\" " line) filename))))
|
|
|
9217 (efs-copy-file-internal
|
|
|
9218 temp temp-parsed newname newname-parsed (if append 'append t) nil
|
|
|
9219 (if (eq msg 0) 1 msg)
|
|
|
9220 (efs-cont (result line cont-lines) (temp newname cont)
|
|
|
9221 (efs-del-tmp-name temp)
|
|
|
9222 (if cont
|
|
|
9223 (efs-call-cont cont result line cont-lines)
|
|
|
9224 (if result
|
|
|
9225 (signal 'ftp-error
|
|
|
9226 (list "Opening output file"
|
|
|
9227 (format "FTP Error: \"%s\" " line) newname)))))
|
|
|
9228 nowait xfer-type)))
|
|
|
9229 nowait xfer-type)))
|
|
|
9230
|
|
|
9231 (defun efs-copy-file-internal (filename filename-parsed newname newname-parsed
|
|
|
9232 ok-if-already-exists keep-date
|
|
|
9233 &optional msg cont nowait xfer-type)
|
|
|
9234 ;; Internal function for copying a file from FILENAME to NEWNAME.
|
|
|
9235 ;; FILENAME-PARSED and NEWNAME-PARSED are the lists obtained by parsing
|
|
|
9236 ;; FILENAME and NEWNAME with efs-ftp-path.
|
|
|
9237 ;; If OK-IF-ALREADY-EXISTS is nil, then existing files will not be
|
|
|
9238 ;; overwritten.
|
|
|
9239 ;; If it is a number, then the user will be prompted about overwriting.
|
|
|
9240 ;; If it eq 'append, then an existing file will be appended to.
|
|
|
9241 ;; If it has anyother value, then existing files will be silently
|
|
|
9242 ;; overwritten.
|
|
|
9243 ;; If KEEP-DATE is t then we will attempt to reatin the date of the
|
|
|
9244 ;; original copy of the file. If this is a string, the modtime of the
|
|
|
9245 ;; NEWNAME will be set to this date. Must be in touch -t format.
|
|
|
9246 ;; If MSG is nil, then the copying will be done silently.
|
|
|
9247 ;; If it is a string, then that will be the massage displayed while copying.
|
|
|
9248 ;; If it is 0, then a suitable default message will be computed.
|
|
|
9249 ;; If it is 1, then a suitable default will be computed, assuming
|
|
|
9250 ;; that FILENAME is a temporary file, whose name is not suitable to use
|
|
|
9251 ;; in a status message.
|
|
|
9252 ;; If it is 2, then a suitable default will be used, assuming that
|
|
|
9253 ;; NEWNAME is a temporary file.
|
|
|
9254 ;; CONT is a continuation to call after completing the copy.
|
|
|
9255 ;; The first two args are RESULT and LINE, the result symbol and status
|
|
|
9256 ;; line of the FTP command. If more than one ftp command has been used,
|
|
|
9257 ;; then these values for the last FTP command are given.
|
|
|
9258 ;; NOWAIT can be either nil, 0, 1, t. See `efs-send-cmd' for an explanation.
|
|
|
9259 ;; XFER-TYPE is the transfer type to use for transferring the files.
|
|
|
9260 ;; If this is nil, than a suitable transfer type is computed.
|
|
|
9261 ;; Does not call expand-file-name. Do that yourself.
|
|
|
9262
|
|
|
9263 ;; check to see if we can overwrite
|
|
|
9264 (if (or (not ok-if-already-exists)
|
|
|
9265 (numberp ok-if-already-exists))
|
|
|
9266 (efs-barf-or-query-if-file-exists
|
|
|
9267 newname "copy to it" (numberp ok-if-already-exists)))
|
|
|
9268 (if (null (or filename-parsed newname-parsed))
|
|
|
9269 ;; local to local copy
|
|
|
9270 (progn
|
|
|
9271 (if (eq ok-if-already-exists 'append)
|
|
|
9272 (efs-concatenate-files filename newname)
|
|
|
9273 (copy-file filename newname ok-if-already-exists keep-date))
|
|
|
9274 (if cont
|
|
|
9275 (efs-call-cont cont nil "Copied locally" "")))
|
|
|
9276 (let* ((f-host (car filename-parsed))
|
|
|
9277 (f-user (nth 1 filename-parsed))
|
|
|
9278 (f-path (nth 2 filename-parsed))
|
|
|
9279 (f-host-type (efs-host-type f-host f-user))
|
|
|
9280 (f-gate-p (efs-use-gateway-p f-host t))
|
|
|
9281 (t-host (car newname-parsed))
|
|
|
9282 (t-user (nth 1 newname-parsed))
|
|
|
9283 (t-path (nth 2 newname-parsed))
|
|
|
9284 (t-host-type (efs-host-type t-host t-user))
|
|
|
9285 (t-gate-p (efs-use-gateway-p t-host t))
|
|
|
9286 (append-p (eq ok-if-already-exists 'append))
|
|
|
9287 gatename)
|
|
|
9288
|
|
|
9289 (if (and (eq keep-date t) (null newname-parsed))
|
|
|
9290 ;; f-host must be remote now.
|
|
|
9291 (setq keep-date filename))
|
|
|
9292
|
|
|
9293 (cond
|
|
|
9294
|
|
|
9295 ;; Check to see if we can do a PUT
|
|
|
9296 ((or
|
|
|
9297 (and (null f-host)
|
|
|
9298 (or (null t-gate-p)
|
|
|
9299 (setq gatename (efs-local-to-gateway-filename filename))))
|
|
|
9300 (and t-gate-p
|
|
|
9301 f-host
|
|
|
9302 (string-equal (downcase f-host) (downcase efs-gateway-host))
|
|
|
9303 (if (memq f-host-type efs-case-insensitive-host-types)
|
|
|
9304 (string-equal (downcase f-user)
|
|
|
9305 (downcase (efs-get-user efs-gateway-host)))
|
|
|
9306 (string-equal f-user (efs-get-user efs-gateway-host)))))
|
|
|
9307 (or f-host (let (file-name-handler-alist)
|
|
|
9308 (if (file-exists-p filename)
|
|
|
9309 (cond
|
|
|
9310 ((file-directory-p filename)
|
|
|
9311 (signal 'file-error
|
|
|
9312 (list "Non-regular file"
|
|
|
9313 "is a directory" filename)))
|
|
|
9314 ((not (file-readable-p filename))
|
|
|
9315 (signal 'file-error
|
|
|
9316 (list "Opening input file"
|
|
|
9317 "permission denied" filename))))
|
|
|
9318 (signal 'file-error
|
|
|
9319 (list "Opening input file"
|
|
|
9320 "no such file or directory" filename)))))
|
|
|
9321 (or xfer-type
|
|
|
9322 (setq xfer-type
|
|
|
9323 (efs-xfer-type f-host-type filename t-host-type newname)))
|
|
|
9324 (let ((size (and (or (null f-host-type)
|
|
|
9325 (efs-file-entry-p filename))
|
|
|
9326 (nth 7 (file-attributes filename)))))
|
|
|
9327 ;; -1 is a bogus size for remote files
|
|
|
9328 (if (eq size -1) (setq size nil))
|
|
|
9329 (efs-send-cmd
|
|
|
9330 t-host t-user
|
|
|
9331 (list (if append-p 'append 'put)
|
|
|
9332 (if f-host
|
|
|
9333 f-path
|
|
|
9334 (or gatename filename))
|
|
|
9335 t-path
|
|
|
9336 xfer-type)
|
|
|
9337 (cond ((eq msg 2)
|
|
|
9338 (concat (if append-p "Appending " "Putting ")
|
|
|
9339 (efs-relativize-filename filename)))
|
|
|
9340 ((eq msg 1)
|
|
|
9341 (concat (if append-p "Appending " "Putting ")
|
|
|
9342 (efs-relativize-filename newname)))
|
|
|
9343 ((eq msg 0)
|
|
|
9344 (concat (if append-p "Appending " "Copying ")
|
|
|
9345 (efs-relativize-filename filename)
|
|
|
9346 " to "
|
|
|
9347 (efs-relativize-filename
|
|
|
9348 newname (file-name-directory filename) filename)))
|
|
|
9349 (t msg))
|
|
|
9350 (and size (list 'efs-set-xfer-size t-host t-user size))
|
|
|
9351 (efs-cont (result line cont-lines) (newname t-host-type t-user size
|
|
|
9352 append-p cont)
|
|
|
9353 (if result
|
|
|
9354 (if cont
|
|
|
9355 (efs-call-cont cont result line cont-lines)
|
|
|
9356 (signal 'ftp-error
|
|
|
9357 (list "Opening output file"
|
|
|
9358 (format "FTP Error: \"%s\" " line) newname)))
|
|
|
9359 ;; add file entry
|
|
|
9360 (efs-copy-add-file-entry newname t-host-type t-user
|
|
|
9361 size append-p)
|
|
|
9362 (if cont
|
|
|
9363 (efs-call-cont cont result line cont-lines))))
|
|
|
9364 nowait)))
|
|
|
9365
|
|
|
9366 ;; Check to see if we can do a GET
|
|
|
9367 ((and
|
|
|
9368 ;; I think that giving the append arg, will cause this function
|
|
|
9369 ;; to make a temp file, recursively call itself, and append the temp
|
|
|
9370 ;; file to the local file. Hope it works out...
|
|
|
9371 (null append-p)
|
|
|
9372 (or
|
|
|
9373 (and (null t-host)
|
|
|
9374 (or (null f-gate-p)
|
|
|
9375 (setq gatename (efs-local-to-gateway-filename newname))))
|
|
|
9376 (and f-gate-p
|
|
|
9377 t-host
|
|
|
9378 (string-equal (downcase t-host) (downcase efs-gateway-host))
|
|
|
9379 (if (memq t-host-type efs-case-insensitive-host-types)
|
|
|
9380 (string-equal (downcase t-user)
|
|
|
9381 (downcase (efs-get-user efs-gateway-host)))
|
|
|
9382 (string-equal t-user (efs-get-user efs-gateway-host))))))
|
|
|
9383 (or t-host (let (file-name-handler-alist)
|
|
|
9384 (cond ((not (file-writable-p newname))
|
|
|
9385 (signal 'file-error
|
|
|
9386 (list "Opening output file"
|
|
|
9387 "permission denied" newname)))
|
|
|
9388 ((file-directory-p newname)
|
|
|
9389 (signal 'file-error
|
|
|
9390 (list "Opening output file"
|
|
|
9391 "is a directory" newname))))))
|
|
|
9392 (or xfer-type
|
|
|
9393 (setq xfer-type
|
|
|
9394 (efs-xfer-type f-host-type filename t-host-type newname)))
|
|
|
9395 (let ((size (and (or (null f-host-type)
|
|
|
9396 (efs-file-entry-p filename))
|
|
|
9397 (nth 7 (file-attributes filename)))))
|
|
|
9398 ;; -1 is a bogus size for remote files.
|
|
|
9399 (if (eq size -1) (setq size nil))
|
|
|
9400 (efs-send-cmd
|
|
|
9401 f-host f-user
|
|
|
9402 (list 'get
|
|
|
9403 f-path
|
|
|
9404 (if t-host
|
|
|
9405 t-path
|
|
|
9406 (or gatename newname))
|
|
|
9407 xfer-type)
|
|
|
9408 (cond ((eq msg 0)
|
|
|
9409 (concat "Copying "
|
|
|
9410 (efs-relativize-filename filename)
|
|
|
9411 " to "
|
|
|
9412 (efs-relativize-filename
|
|
|
9413 newname (file-name-directory filename) filename)))
|
|
|
9414 ((eq msg 2)
|
|
|
9415 (concat "Getting " (efs-relativize-filename filename)))
|
|
|
9416 ((eq msg 1)
|
|
|
9417 (concat "Getting " (efs-relativize-filename newname)))
|
|
|
9418 (t msg))
|
|
|
9419 ;; If the server emits a efs-xfer-size-msgs, it will over-ride this.
|
|
|
9420 ;; With no xfer msg, this is will do the job.
|
|
|
9421 (and size (list 'efs-set-xfer-size f-host f-user size))
|
|
|
9422 (efs-cont (result line cont-lines) (filename newname size
|
|
|
9423 t-host-type t-user
|
|
|
9424 cont keep-date)
|
|
|
9425 (if result
|
|
|
9426 (if cont
|
|
|
9427 (efs-call-cont cont result line cont-lines)
|
|
|
9428 (signal 'ftp-error
|
|
|
9429 (list "Opening input file"
|
|
|
9430 (format "FTP Error: \"%s\" " line) filename)))
|
|
|
9431 ;; Add a new file entry, if relevant.
|
|
|
9432 (if t-host-type
|
|
|
9433 ;; t-host will be equal to efs-gateway-host, if t-host-type
|
|
|
9434 ;; is non-nil.
|
|
|
9435 (efs-copy-add-file-entry newname t-host-type
|
|
|
9436 t-user size nil))
|
|
|
9437 (if (and (null t-host-type) (stringp keep-date))
|
|
|
9438 (efs-set-mdtm-of
|
|
|
9439 filename newname
|
|
|
9440 (and cont
|
|
|
9441 (efs-cont (result1 line1 cont-lines1) (result
|
|
|
9442 line cont-lines
|
|
|
9443 cont)
|
|
|
9444 (efs-call-cont cont result line cont-lines))))
|
|
|
9445 (if cont
|
|
|
9446 (efs-call-cont cont result line cont-lines)))))
|
|
|
9447 nowait)))
|
|
|
9448
|
|
|
9449 ;; Can we do a EXEC cp?
|
|
|
9450 ((and t-host f-host
|
|
|
9451 (string-equal (downcase t-host) (downcase f-host))
|
|
|
9452 (if (memq t-host-type efs-case-insensitive-host-types)
|
|
|
9453 (string-equal (downcase t-user) (downcase f-user))
|
|
|
9454 (string-equal t-user f-user)))
|
|
|
9455 (efs-copy-on-remote
|
|
|
9456 t-host t-user t-host-type filename newname filename-parsed
|
|
|
9457 newname-parsed keep-date append-p
|
|
|
9458 (cond ((eq msg 0)
|
|
|
9459 (concat "Copying "
|
|
|
9460 (efs-relativize-filename filename)
|
|
|
9461 " to "
|
|
|
9462 (efs-relativize-filename
|
|
|
9463 newname (file-name-directory filename) filename)))
|
|
|
9464 ((eq msg 1)
|
|
|
9465 (concat "Copying " (efs-relativize-filename newname)))
|
|
|
9466 ((eq msg 2)
|
|
|
9467 (concat "Copying " (efs-relativize-filename filename)))
|
|
|
9468 (t msg))
|
|
|
9469 cont nowait xfer-type))
|
|
|
9470
|
|
|
9471 ;; Try for a copy with PASV
|
|
|
9472 ((and t-host f-host
|
|
|
9473 (not (and (string-equal (downcase t-host) (downcase f-host))
|
|
|
9474 (if (memq t-host-type efs-case-insensitive-host-types)
|
|
|
9475 (string-equal (downcase t-user) (downcase f-user))
|
|
|
9476 (string-equal t-user f-user))))
|
|
|
9477 (or
|
|
|
9478 (and efs-gateway-host
|
|
|
9479 ;; The gateway should be able to talk to anything.
|
|
|
9480 (let ((gh (downcase efs-gateway-host)))
|
|
|
9481 (or (string-equal (downcase t-host) gh)
|
|
|
9482 (string-equal (downcase f-host) gh))))
|
|
|
9483 (efs-save-match-data
|
|
|
9484 (eq (null (string-match efs-local-host-regexp t-host))
|
|
|
9485 (null (string-match efs-local-host-regexp f-host))))))
|
|
|
9486 (efs-copy-remote-to-remote
|
|
|
9487 f-host-type f-host f-user f-path filename
|
|
|
9488 t-host-type t-host t-user t-path newname
|
|
|
9489 append-p
|
|
|
9490 (cond ((eq msg 0)
|
|
|
9491 (concat "Copying "
|
|
|
9492 (efs-relativize-filename filename)
|
|
|
9493 " to "
|
|
|
9494 (efs-relativize-filename
|
|
|
9495 newname (file-name-directory filename) filename)))
|
|
|
9496 ((eq msg 1)
|
|
|
9497 (concat "Copying " (efs-relativize-filename newname)))
|
|
|
9498 ((eq msg 2)
|
|
|
9499 (concat "Copying " (efs-relativize-filename filename)))
|
|
|
9500 (t msg))
|
|
|
9501 (efs-cont (result line cont-lines)
|
|
|
9502 (filename filename-parsed newname newname-parsed
|
|
|
9503 append-p keep-date msg cont nowait xfer-type)
|
|
|
9504 (if result
|
|
|
9505 ;; PASV didn't work. Do things the old-fashioned
|
|
|
9506 ;; way.
|
|
|
9507 (efs-copy-via-temp
|
|
|
9508 filename filename-parsed newname newname-parsed
|
|
|
9509 append-p keep-date msg cont nowait xfer-type)
|
|
|
9510 (if cont
|
|
|
9511 (efs-call-cont cont result line cont-lines))))
|
|
|
9512 nowait xfer-type))
|
|
|
9513
|
|
|
9514 ;; Can't do anything direct. Divide and conquer.
|
|
|
9515 (t
|
|
|
9516 (efs-copy-via-temp filename filename-parsed newname newname-parsed
|
|
|
9517 append-p keep-date msg cont nowait xfer-type))))))
|
|
|
9518
|
|
|
9519 (defun efs-copy-file (filename newname &optional ok-if-already-exists
|
|
|
9520 keep-date nowait)
|
|
|
9521 ;; Version of copy file for remote files. Actually, will also work
|
|
|
9522 ;; for local files too, since efs-copy-file-internal can copy anything.
|
|
|
9523 ;; If called interactively, copies asynchronously.
|
|
|
9524 (setq filename (expand-file-name filename)
|
|
|
9525 newname (expand-file-name newname))
|
|
|
9526 (if (eq ok-if-already-exists 'append)
|
|
|
9527 (setq ok-if-already-exists t))
|
|
|
9528 (efs-copy-file-internal filename (efs-ftp-path filename)
|
|
|
9529 newname (efs-ftp-path newname)
|
|
|
9530 ok-if-already-exists keep-date 0 nil nowait))
|
|
|
9531
|
|
|
9532 ;;;; ------------------------------------------------------------
|
|
|
9533 ;;;; File renaming support.
|
|
|
9534 ;;;; ------------------------------------------------------------
|
|
|
9535
|
|
|
9536 (defun efs-rename-get-file-list (dir ent)
|
|
|
9537 ;; From hashtable ENT for DIR returns a list of all files except "."
|
|
|
9538 ;; and "..".
|
|
|
9539 (let (list)
|
|
|
9540 (efs-map-hashtable
|
|
|
9541 (function
|
|
|
9542 (lambda (key val)
|
|
|
9543 (or (string-equal "." key) (string-equal ".." key)
|
|
|
9544 (setq list
|
|
|
9545 (cons (expand-file-name key dir) list)))))
|
|
|
9546 ent)
|
|
|
9547 list))
|
|
|
9548
|
|
|
9549 (defun efs-rename-get-files (dir cont nowait)
|
|
|
9550 ;; Obtains a list of files in directory DIR (except . and ..), and applies
|
|
|
9551 ;; CONT to the list. Doesn't return anything useful.
|
|
|
9552 (let* ((dir (file-name-as-directory dir))
|
|
|
9553 (ent (efs-get-files-hashtable-entry dir)))
|
|
|
9554 (if ent
|
|
|
9555 (efs-call-cont cont (efs-rename-get-file-list dir ent))
|
|
|
9556 (efs-ls
|
|
|
9557 dir (efs-ls-guess-switches) t nil t nowait
|
|
|
9558 (efs-cont (listing) (dir cont)
|
|
|
9559 (efs-call-cont
|
|
|
9560 cont (and listing
|
|
|
9561 (efs-rename-get-file-list
|
|
|
9562 dir (efs-get-files-hashtable-entry dir)))))))))
|
|
|
9563
|
|
|
9564 (defun efs-rename-get-local-file-tree (dir)
|
|
|
9565 ;; Returns a list of the full directory tree under DIR, for DIR on the
|
|
|
9566 ;; local host. The list is in tree order.
|
|
|
9567 (let ((res (list dir)))
|
|
|
9568 (mapcar
|
|
|
9569 (function
|
|
|
9570 (lambda (file)
|
|
|
9571 (if (file-directory-p file)
|
|
|
9572 (nconc res (delq nil (mapcar
|
|
|
9573 (function
|
|
|
9574 (lambda (f)
|
|
|
9575 (and (not (string-equal "." f))
|
|
|
9576 (not (string-equal ".." f))
|
|
|
9577 (expand-file-name f file))))
|
|
|
9578 (directory-files file)))))))
|
|
|
9579 res)
|
|
|
9580 res))
|
|
|
9581
|
|
|
9582 (defun efs-rename-get-remote-file-tree (next curr total cont nowait)
|
|
|
9583 ;; Builds a hierarchy of files.
|
|
|
9584 ;; NEXT is the next level so far.
|
|
|
9585 ;; CURR are unprocessed files in the current level.
|
|
|
9586 ;; TOTAL is the processed files so far.
|
|
|
9587 ;; CONT is a cont. function called on the total list after all files
|
|
|
9588 ;; are processed.
|
|
|
9589 ;; NOWAIT non-nil means run asynch.
|
|
|
9590 (or curr (setq curr next
|
|
|
9591 next nil))
|
|
|
9592 (if curr
|
|
|
9593 (let ((file (car curr)))
|
|
|
9594 (setq curr (cdr curr)
|
|
|
9595 total (cons file total))
|
|
|
9596 (if (file-directory-p file)
|
|
|
9597 (efs-rename-get-files
|
|
|
9598 file
|
|
|
9599 (efs-cont (list) (next curr total cont nowait)
|
|
|
9600 (efs-rename-get-remote-file-tree (nconc next list)
|
|
|
9601 curr total cont nowait))
|
|
|
9602 nowait)
|
|
|
9603 (efs-rename-get-remote-file-tree next curr total cont nowait)))
|
|
|
9604 (efs-call-cont cont (nreverse total))))
|
|
|
9605
|
|
|
9606 (defun efs-rename-make-targets (files from-dir-len to-dir host user host-type
|
|
|
9607 cont nowait)
|
|
|
9608 ;; Make targets (copy a file or make a subdir) on local or host
|
|
|
9609 ;; for the files in list. Afterwhich, call CONT.
|
|
|
9610 (if files
|
|
|
9611 (let* ((from (car files))
|
|
|
9612 (files (cdr files))
|
|
|
9613 (to (concat to-dir (substring from from-dir-len))))
|
|
|
9614 (if (file-directory-p from)
|
|
|
9615 (if host-type
|
|
|
9616 (let ((dir (nth 2 (efs-ftp-path to))))
|
|
|
9617 (or (memq host-type efs-unix-host-types)
|
|
|
9618 (memq host-type '(dos os2))
|
|
|
9619 (setq dir (efs-internal-file-name-as-directory nil dir)))
|
|
|
9620 (efs-send-cmd
|
|
|
9621 host user (list 'mkdir dir)
|
|
|
9622 (format "Making directory %s" (efs-relativize-filename to))
|
|
|
9623 nil
|
|
|
9624 (efs-cont (res line cont-lines) (to files from-dir-len
|
|
|
9625 to-dir host user
|
|
|
9626 host-type cont nowait)
|
|
|
9627 (if res
|
|
|
9628 (if cont
|
|
|
9629 (efs-call-cont cont res line cont-lines)
|
|
|
9630 (signal 'ftp-error
|
|
|
9631 (list "Making directory"
|
|
|
9632 (format "FTP Error: \"%s\"" line)
|
|
|
9633 to)))
|
|
|
9634 (efs-rename-make-targets
|
|
|
9635 files from-dir-len to-dir host user
|
|
|
9636 host-type cont nowait)))
|
|
|
9637 nowait))
|
|
|
9638 (condition-case nil
|
|
|
9639 (make-directory-internal to)
|
|
|
9640 (error (efs-call-cont
|
|
|
9641 cont 'failed (format "Failed to mkdir %s" to) "")))
|
|
|
9642 (efs-rename-make-targets
|
|
|
9643 files from-dir-len to-dir host user host-type cont nowait))
|
|
|
9644 (efs-copy-file-internal
|
|
|
9645 from (efs-ftp-path from) to (and host-type (efs-ftp-path to)) nil t
|
|
|
9646 (format "Renaming %s to %s" (efs-relativize-filename from)
|
|
|
9647 (efs-relativize-filename to))
|
|
|
9648 (efs-cont (res line cont-lines) (from to files from-dir-len to-dir
|
|
|
9649 host user host-type cont
|
|
|
9650 nowait)
|
|
|
9651 (if res
|
|
|
9652 (if cont
|
|
|
9653 (efs-call-cont cont res line cont-lines)
|
|
|
9654 (signal 'ftp-error
|
|
|
9655 (list "Renaming"
|
|
|
9656 (format "FTP Error: \"%s\"" line) from to)))
|
|
|
9657 (efs-rename-make-targets
|
|
|
9658 files from-dir-len to-dir host user host-type cont nowait)))
|
|
|
9659 nowait)))
|
|
|
9660 (if cont (efs-call-cont cont nil "" ""))))
|
|
|
9661
|
|
|
9662 (defun efs-rename-delete-on-local (files)
|
|
|
9663 ;; Delete the files FILES, and then run CONT.
|
|
|
9664 ;; FILES are assumed to be in inverse tree order.
|
|
|
9665 (message "Deleting files...")
|
|
|
9666 (mapcar
|
|
|
9667 (function
|
|
|
9668 (lambda (f)
|
|
|
9669 (condition-case nil
|
|
|
9670 (if (file-directory-p f)
|
|
|
9671 (delete-directory f)
|
|
|
9672 (delete-file f))
|
|
|
9673 (file-error nil)))) ; don't complain if the file is already gone.
|
|
|
9674 files)
|
|
|
9675 (message "Deleting files...done"))
|
|
|
9676
|
|
|
9677 (defun efs-rename-delete-on-remote (files host user host-type cont nowait)
|
|
|
9678 ;; Deletes the list FILES on a remote host. When done calls CONT.
|
|
|
9679 ;; FILES is assumed to be in reverse tree order.
|
|
|
9680 (if files
|
|
|
9681 (let* ((f (car files))
|
|
|
9682 (rf (nth 2 (efs-ftp-path f))))
|
|
|
9683 (progn
|
|
|
9684 (setq files (cdr files))
|
|
|
9685 (if (file-directory-p f)
|
|
|
9686 (let ((rf (if (memq host-type (append efs-unix-host-types
|
|
|
9687 '(dos os2)))
|
|
|
9688 (efs-internal-directory-file-name f)
|
|
|
9689 (efs-internal-file-name-as-directory nil f))))
|
|
|
9690
|
|
|
9691 (efs-send-cmd
|
|
|
9692 host user (list 'rmdir rf)
|
|
|
9693 (concat "Deleting directory " (efs-relativize-filename f))
|
|
|
9694 nil
|
|
|
9695 (efs-cont (res line cont-lines) (f files host user host-type
|
|
|
9696 cont nowait)
|
|
|
9697 (if (and res
|
|
|
9698 (efs-save-match-data
|
|
|
9699 (not (string-match "^550 " line))))
|
|
|
9700 (if cont
|
|
|
9701 (efs-call-cont cont res line cont-lines)
|
|
|
9702 (signal 'ftp-error
|
|
|
9703 (list "Deleting directory"
|
|
|
9704 (format "FTP Error: \"%s\"" line)
|
|
|
9705 f)))
|
|
|
9706 (efs-rename-delete-on-remote
|
|
|
9707 files host user host-type cont nowait)))
|
|
|
9708 nowait))
|
|
|
9709 (efs-send-cmd
|
|
|
9710 host user (list 'delete rf)
|
|
|
9711 (concat "Deleting " rf)
|
|
|
9712 nil
|
|
|
9713 (efs-cont (res line cont-lines) (f files host user host-type
|
|
|
9714 cont nowait)
|
|
|
9715 (if (and res
|
|
|
9716 (efs-save-match-data
|
|
|
9717 (not (string-match "^550 " line))))
|
|
|
9718 (if cont
|
|
|
9719 (efs-call-cont cont res line cont-lines)
|
|
|
9720 (signal 'ftp-error
|
|
|
9721 (list "Deleting"
|
|
|
9722 (format "FTP Error: \"%s\"" line)
|
|
|
9723 f)))
|
|
|
9724 (efs-rename-delete-on-remote
|
|
|
9725 files host user host-type cont nowait)))
|
|
|
9726 nowait))))
|
|
|
9727 (if cont (efs-call-cont cont nil "" ""))))
|
|
|
9728
|
|
|
9729 (defun efs-rename-on-remote (host user old-path new-path old-file new-file
|
|
|
9730 msg nowait cont)
|
|
|
9731 ;; Run a rename command on the remote server.
|
|
|
9732 ;; OLD-PATH and NEW-PATH are in full efs syntax.
|
|
|
9733 ;; OLD-FILE and NEW-FILE are the remote full pathnames, not in efs syntax.
|
|
|
9734 (efs-send-cmd
|
|
|
9735 host user (list 'rename old-file new-file) msg nil
|
|
|
9736 (efs-cont (result line cont-lines) (cont old-path new-path host)
|
|
|
9737 (if result
|
|
|
9738 (progn
|
|
|
9739 (or (and (>= (length line) 4)
|
|
|
9740 (string-equal "550 " (substring line 0 4)))
|
|
|
9741 (efs-set-host-property host 'rnfr-failed t))
|
|
|
9742 (if cont
|
|
|
9743 (efs-call-cont cont result line cont-lines)
|
|
|
9744 (signal 'ftp-error
|
|
|
9745 (list "Renaming"
|
|
|
9746 (format "FTP Error: \"%s\"" line)
|
|
|
9747 old-path new-path))))
|
|
|
9748 (let ((entry (efs-get-file-entry old-path))
|
|
|
9749 (host-type (efs-host-type host))
|
|
|
9750 ;; If no file entry, do extra work on the hashtable,
|
|
|
9751 ;; rather than force a listing.
|
|
|
9752 (dir-p (or (not (efs-file-entry-p old-path))
|
|
|
9753 (file-directory-p old-path))))
|
|
|
9754 (apply 'efs-add-file-entry host-type new-path
|
|
|
9755 (eq (car entry) t) (cdr entry))
|
|
|
9756 (efs-delete-file-entry host-type old-path)
|
|
|
9757 (if dir-p
|
|
|
9758 (let* ((old (efs-canonize-file-name
|
|
|
9759 (file-name-as-directory old-path)))
|
|
|
9760 (new (efs-canonize-file-name
|
|
|
9761 (file-name-as-directory new-path)))
|
|
|
9762 (old-len (length old))
|
|
|
9763 (new-tbl (efs-make-hashtable
|
|
|
9764 (length efs-files-hashtable))))
|
|
|
9765 (efs-map-hashtable
|
|
|
9766 (function
|
|
|
9767 (lambda (key val)
|
|
|
9768 (if (and (>= (length key) old-len)
|
|
|
9769 (string-equal (substring key 0 old-len)
|
|
|
9770 old))
|
|
|
9771 (efs-put-hash-entry
|
|
|
9772 (concat new (substring key old-len)) val new-tbl)
|
|
|
9773 (efs-put-hash-entry key val new-tbl))))
|
|
|
9774 efs-files-hashtable)
|
|
|
9775 (setq efs-files-hashtable new-tbl)))
|
|
|
9776 (if cont (efs-call-cont cont result line cont-lines)))))
|
|
|
9777 nowait))
|
|
|
9778
|
|
|
9779 (defun efs-rename-local-to-remote (filename newname newname-parsed
|
|
|
9780 msg cont nowait)
|
|
|
9781 ;; Renames a file from the local host to a remote host.
|
|
|
9782 (if (file-directory-p filename)
|
|
|
9783 (let* ((files (efs-rename-get-local-file-tree filename))
|
|
|
9784 (to-dir (directory-file-name newname))
|
|
|
9785 (filename (directory-file-name filename))
|
|
|
9786 (len (length filename))
|
|
|
9787 (t-parsed (efs-ftp-path to-dir))
|
|
|
9788 (host (car t-parsed))
|
|
|
9789 (user (nth 1 t-parsed))
|
|
|
9790 (host-type (efs-host-type host)))
|
|
|
9791 ;; MSG is never passed here, instead messages are constructed
|
|
|
9792 ;; internally. I don't know how to use a single message
|
|
|
9793 ;; in a function which sends so many FTP commands.
|
|
|
9794 (efs-rename-make-targets
|
|
|
9795 files len to-dir host user host-type
|
|
|
9796 (efs-cont (result line cont-lines) (files filename newname cont)
|
|
|
9797 (if result
|
|
|
9798 (if cont
|
|
|
9799 (efs-call-cont cont result line cont-lines)
|
|
|
9800 (signal 'ftp-error
|
|
|
9801 (list "Renaming" (format "FTP Error: \"%s\"" line)
|
|
|
9802 filename newname)))
|
|
|
9803 (efs-rename-delete-on-local (nreverse files))
|
|
|
9804 (if cont (efs-call-cont cont result line cont-lines))))
|
|
|
9805 nowait))
|
|
|
9806 (efs-copy-file-internal
|
|
|
9807 filename nil newname newname-parsed t t msg
|
|
|
9808 (efs-cont (result line cont-lines) (filename cont)
|
|
|
9809 (if result
|
|
|
9810 (if cont
|
|
|
9811 (efs-call-cont cont result line cont-lines)
|
|
|
9812 (signal 'ftp-error
|
|
|
9813 (list "Renaming"
|
|
|
9814 (format "FTP Error: \"%s\"" line)
|
|
|
9815 filename newname)))
|
|
|
9816 (condition-case nil
|
|
|
9817 (delete-file filename)
|
|
|
9818 (error nil))
|
|
|
9819 (if cont (efs-call-cont cont result line cont-lines))))
|
|
|
9820 nowait)))
|
|
|
9821
|
|
|
9822 (defun efs-rename-from-remote (filename filename-parsed newname newname-parsed
|
|
|
9823 msg cont nowait)
|
|
|
9824 (let ((f-host (car filename-parsed))
|
|
|
9825 (f-user (nth 1 filename-parsed))
|
|
|
9826 (fast-nowait (if (eq nowait t) 1 nowait)))
|
|
|
9827 (if (file-directory-p filename)
|
|
|
9828 (let* ((t-host (car newname-parsed))
|
|
|
9829 (t-user (nth 1 newname-parsed))
|
|
|
9830 (t-host-type (and t-host (efs-host-type t-host)))
|
|
|
9831 (f-host-type (efs-host-type f-host)))
|
|
|
9832 (efs-rename-get-remote-file-tree
|
|
|
9833 nil (list filename) nil
|
|
|
9834 (efs-cont (list) (filename filename-parsed newname t-host t-user
|
|
|
9835 t-host-type f-host f-user f-host-type
|
|
|
9836 cont fast-nowait)
|
|
|
9837 (efs-rename-make-targets
|
|
|
9838 list (length filename) newname t-host t-user t-host-type
|
|
|
9839 (efs-cont (res line cont-lines) (filename newname f-host f-user
|
|
|
9840 f-host-type list cont
|
|
|
9841 fast-nowait)
|
|
|
9842 (if res
|
|
|
9843 (if cont
|
|
|
9844 (efs-call-cont cont res line cont-lines)
|
|
|
9845 (signal 'ftp-error
|
|
|
9846 (list "Renaming"
|
|
|
9847 (format "FTP Error: \"%s\"" line)
|
|
|
9848 filename newname)))
|
|
|
9849 (efs-rename-delete-on-remote
|
|
|
9850 (nreverse list) f-host f-user f-host-type cont
|
|
|
9851 fast-nowait)))
|
|
|
9852 fast-nowait)) nowait))
|
|
|
9853 ;; Do things the simple way.
|
|
|
9854 (let ((f-path (nth 2 filename-parsed))
|
|
|
9855 (f-abbr (efs-relativize-filename filename)))
|
|
|
9856 (efs-copy-file-internal
|
|
|
9857 filename filename-parsed newname newname-parsed t t msg
|
|
|
9858 (efs-cont (result line cont-lines) (filename newname f-host f-user
|
|
|
9859 f-path f-abbr
|
|
|
9860 cont fast-nowait)
|
|
|
9861 (if result
|
|
|
9862 (if cont
|
|
|
9863 (efs-call-cont cont result line cont-lines)
|
|
|
9864 (signal 'ftp-error
|
|
|
9865 (list "Renaming"
|
|
|
9866 (format "FTP Error: \"%s\"" line)
|
|
|
9867 filename newname)))
|
|
|
9868 (efs-send-cmd
|
|
|
9869 f-host f-user (list 'delete f-path)
|
|
|
9870 (format "Removing %s" f-abbr) nil
|
|
|
9871 (efs-cont (result line cont-lines) (filename f-host cont)
|
|
|
9872 (if result
|
|
|
9873 (if cont
|
|
|
9874 (efs-call-cont cont result line cont-lines)
|
|
|
9875 (signal 'ftp-error
|
|
|
9876 (list "Renaming"
|
|
|
9877 (format "Failed to remove %s"
|
|
|
9878 filename)
|
|
|
9879 "FTP Error: \"%s\"" line)))
|
|
|
9880 (efs-delete-file-entry (efs-host-type f-host)
|
|
|
9881 filename)
|
|
|
9882 (if cont
|
|
|
9883 (efs-call-cont cont result line cont-lines))))
|
|
|
9884 fast-nowait))) nowait)))))
|
|
|
9885
|
|
|
9886 (defun efs-rename-file-internal (filename newname ok-if-already-exists
|
|
|
9887 &optional msg cont nowait)
|
|
|
9888 ;; Internal version of rename-file for remote files.
|
|
|
9889 ;; Takes CONT and NOWAIT args.
|
|
|
9890 (let ((filename (expand-file-name filename))
|
|
|
9891 (newname (expand-file-name newname)))
|
|
|
9892 (let ((f-parsed (efs-ftp-path filename))
|
|
|
9893 (t-parsed (efs-ftp-path newname)))
|
|
|
9894 (if (null (or f-parsed t-parsed))
|
|
|
9895 (progn
|
|
|
9896 ;; local rename
|
|
|
9897 (rename-file filename newname ok-if-already-exists)
|
|
|
9898 (if cont
|
|
|
9899 (efs-call-cont cont nil "Renamed locally" "")))
|
|
|
9900
|
|
|
9901 ;; check to see if we can overwrite
|
|
|
9902 (if (or (not ok-if-already-exists)
|
|
|
9903 (numberp ok-if-already-exists))
|
|
|
9904 (efs-barf-or-query-if-file-exists
|
|
|
9905 newname "rename to it" (numberp ok-if-already-exists)))
|
|
|
9906
|
|
|
9907 (let ((f-abbr (efs-relativize-filename filename))
|
|
|
9908 (t-abbr (efs-relativize-filename newname
|
|
|
9909 (file-name-directory filename)
|
|
|
9910 filename)))
|
|
|
9911 (or msg (setq msg (format "Renaming %s to %s" f-abbr t-abbr)))
|
|
|
9912 (if f-parsed
|
|
|
9913 (let* ((f-host (car f-parsed))
|
|
|
9914 (f-user (nth 1 f-parsed))
|
|
|
9915 (f-path (nth 2 f-parsed))
|
|
|
9916 (f-host-type (efs-host-type f-host)))
|
|
|
9917 (if (and t-parsed
|
|
|
9918 (string-equal (downcase f-host)
|
|
|
9919 (downcase (car t-parsed)))
|
|
|
9920 (not (efs-get-host-property f-host 'rnfr-failed))
|
|
|
9921 (if (memq f-host-type efs-case-insensitive-host-types)
|
|
|
9922 (string-equal (downcase f-user)
|
|
|
9923 (downcase (nth 1 t-parsed)))
|
|
|
9924 (string-equal f-user (nth 1 t-parsed))))
|
|
|
9925 ;; Can run a RENAME command on the server.
|
|
|
9926 (efs-rename-on-remote
|
|
|
9927 f-host f-user filename newname f-path (nth 2 t-parsed)
|
|
|
9928 msg nowait
|
|
|
9929 (efs-cont (result line cont-lines) (f-host
|
|
|
9930 filename
|
|
|
9931 newname
|
|
|
9932 ok-if-already-exists
|
|
|
9933 msg cont nowait)
|
|
|
9934 (if result
|
|
|
9935 (progn
|
|
|
9936 (efs-set-host-property f-host 'rnfr-failed t)
|
|
|
9937 (efs-rename-file-internal
|
|
|
9938 filename newname ok-if-already-exists msg cont
|
|
|
9939 (if (eq nowait t) 1 nowait)))
|
|
|
9940 (if cont
|
|
|
9941 (efs-call-cont cont result line cont-lines)))))
|
|
|
9942 ;; remote to remote
|
|
|
9943 (efs-rename-from-remote filename f-parsed newname t-parsed
|
|
|
9944 msg cont nowait)))
|
|
|
9945 ;; local to remote
|
|
|
9946 (efs-rename-local-to-remote
|
|
|
9947 filename newname t-parsed msg cont nowait)))))))
|
|
|
9948
|
|
|
9949 (defun efs-rename-file (filename newname &optional ok-if-already-exists nowait)
|
|
|
9950 ;; Does file renaming for remote files.
|
|
|
9951 (efs-rename-file-internal filename newname ok-if-already-exists
|
|
|
9952 nil nil nowait))
|
|
|
9953
|
|
|
9954 ;;;; ------------------------------------------------------------
|
|
|
9955 ;;;; Making symbolic and hard links.
|
|
|
9956 ;;;; ------------------------------------------------------------
|
|
|
9957
|
|
|
9958 ;;; These functions require that the remote FTP server understand
|
|
|
9959 ;;; SITE EXEC and that ln is in its the ftp-exec path.
|
|
|
9960
|
|
|
9961 (defun efs-try-ln (host user cont nowait)
|
|
|
9962 ;; Do some preemptive testing to see if exec ln works
|
|
|
9963 (if (efs-get-host-property host 'exec-failed)
|
|
|
9964 (signal 'ftp-error (list "Unable to exec ln on host" host)))
|
|
|
9965 (let ((exec-ln (efs-get-host-property host 'exec-ln)))
|
|
|
9966 (cond
|
|
|
9967 ((eq exec-ln 'failed)
|
|
|
9968 (signal 'ftp-error (list "ln is not in FTP exec path on host" host)))
|
|
|
9969 ((eq exec-ln 'works)
|
|
|
9970 (efs-call-cont cont))
|
|
|
9971 (t
|
|
|
9972 (message "Checking for ln executable on %s..." host)
|
|
|
9973 (efs-send-cmd
|
|
|
9974 host user '(quote site exec "ln / /")
|
|
|
9975 nil nil
|
|
|
9976 (efs-cont (result line cont-lines) (host user cont)
|
|
|
9977 (if result
|
|
|
9978 (progn
|
|
|
9979 (efs-set-host-property host 'exec-failed t)
|
|
|
9980 (efs-error host user (format "exec: %s" line)))
|
|
|
9981 ;; Look for an error message
|
|
|
9982 (if (efs-save-match-data
|
|
|
9983 (string-match "\n200-" cont-lines))
|
|
|
9984 (progn
|
|
|
9985 (efs-set-host-property host 'exec-ln 'works)
|
|
|
9986 (efs-call-cont cont))
|
|
|
9987 (efs-set-host-property host 'exec-ln 'failed)
|
|
|
9988 (efs-error host user
|
|
|
9989 (format "ln not in FTP exec path on host %s" host)))))
|
|
|
9990 nowait)))))
|
|
|
9991
|
|
|
9992 (defun efs-make-symbolic-link-internal
|
|
|
9993 (target linkname &optional ok-if-already-exists cont nowait)
|
|
|
9994 ;; Makes remote symbolic links. Assumes that linkname is already expanded.
|
|
|
9995 (let* ((parsed (efs-ftp-path linkname))
|
|
|
9996 (host (car parsed))
|
|
|
9997 (user (nth 1 parsed))
|
|
|
9998 (linkpath (nth 2 parsed))
|
|
|
9999 (abbr (efs-relativize-filename linkname
|
|
|
10000 (file-name-directory target) target))
|
|
|
10001 (tparsed (efs-ftp-path target))
|
|
|
10002 (com-target target)
|
|
|
10003 cmd-string)
|
|
|
10004 (if (null (file-directory-p
|
|
|
10005 (file-name-directory linkname)))
|
|
|
10006 (if cont
|
|
|
10007 (efs-call-cont cont 'failed
|
|
|
10008 (format "no such file or directory, %s" linkname)
|
|
|
10009 "")
|
|
|
10010 (signal 'file-error (list "no such file or directory" linkname)))
|
|
|
10011 (if (or (not ok-if-already-exists)
|
|
|
10012 (numberp ok-if-already-exists))
|
|
|
10013 (efs-barf-or-query-if-file-exists
|
|
|
10014 linkname "make symbolic link" (numberp ok-if-already-exists)))
|
|
|
10015 ;; Do this after above, so that hopefully the host type is sorted out
|
|
|
10016 ;; by now.
|
|
|
10017 (let ((host-type (efs-host-type host)))
|
|
|
10018 (if (or (not (memq host-type efs-unix-host-types))
|
|
|
10019 (memq host-type efs-dumb-host-types)
|
|
|
10020 (efs-get-host-property host 'exec-failed))
|
|
|
10021 (error "Unable to make symbolic links on %s." host)))
|
|
|
10022 ;; Be careful not to spoil relative links, or symlinks to other
|
|
|
10023 ;; machines, which maybe symlink-fix.el can sort out.
|
|
|
10024 (if (and tparsed
|
|
|
10025 (string-equal (downcase (car tparsed)) (downcase host))
|
|
|
10026 (string-equal (nth 1 tparsed) user))
|
|
|
10027 (setq com-target (nth 2 tparsed)))
|
|
|
10028 ;; symlinks only work for unix, so don't need to
|
|
|
10029 ;; convert pathnames. What about VOS?
|
|
|
10030 (setq cmd-string (concat "ln -sf " com-target " " linkpath))
|
|
|
10031 (efs-try-ln
|
|
|
10032 host user
|
|
|
10033 (efs-cont () (host user cmd-string target linkname com-target
|
|
|
10034 abbr cont nowait)
|
|
|
10035 (efs-send-cmd
|
|
|
10036 host user (list 'quote 'site 'exec cmd-string)
|
|
|
10037 (format "Symlinking %s to %s" target abbr)
|
|
|
10038 nil
|
|
|
10039 (efs-cont (result line cont-lines) (host user com-target linkname
|
|
|
10040 cont)
|
|
|
10041 (if result
|
|
|
10042 (progn
|
|
|
10043 (efs-set-host-property host 'exec-failed t)
|
|
|
10044 (efs-error host user (format "exec: %s" line)))
|
|
|
10045 (efs-save-match-data
|
|
|
10046 (if (string-match "\n200-\\([^\n]*\\)" cont-lines)
|
|
|
10047 (let ((err (substring cont-lines (match-beginning 1)
|
|
|
10048 (match-end 1))))
|
|
|
10049 (if cont
|
|
|
10050 (efs-call-cont cont 'failed err cont-lines)
|
|
|
10051 (efs-error host user err)))
|
|
|
10052 (efs-add-file-entry nil linkname com-target nil user)
|
|
|
10053 (if cont (efs-call-cont cont nil line cont-lines))))))
|
|
|
10054 nowait))
|
|
|
10055 nowait))))
|
|
|
10056
|
|
|
10057 (defun efs-make-symbolic-link (target linkname &optional ok-if-already-exists)
|
|
|
10058 ;; efs version of make-symbolic-link
|
|
|
10059 (let* ((linkname (expand-file-name linkname))
|
|
|
10060 (parsed (efs-ftp-path linkname)))
|
|
|
10061 (if parsed
|
|
|
10062 (efs-make-symbolic-link-internal target linkname ok-if-already-exists)
|
|
|
10063 ;; Handler will match on either target or linkname. We are only
|
|
|
10064 ;; interested in the linkname.
|
|
|
10065 (let ((file-name-handler-alist (efs-file-name-handler-alist-sans-fn
|
|
|
10066 'efs-file-handler-function)))
|
|
|
10067 (make-symbolic-link target linkname ok-if-already-exists)))))
|
|
|
10068
|
|
|
10069 (defun efs-add-name-to-file-internal
|
|
|
10070 (file newname &optional ok-if-already-exists cont nowait)
|
|
|
10071 ;; Makes remote symbolic links. Assumes that linkname is already expanded.
|
|
|
10072 (let* ((parsed (efs-ftp-path file))
|
|
|
10073 (host (car parsed))
|
|
|
10074 (user (nth 1 parsed))
|
|
|
10075 (path (nth 2 parsed))
|
|
|
10076 (nparsed (efs-ftp-path newname))
|
|
|
10077 (nhost (car nparsed))
|
|
|
10078 (nuser (nth 1 nparsed))
|
|
|
10079 (npath (nth 2 nparsed))
|
|
|
10080 (abbr (efs-relativize-filename newname
|
|
|
10081 (file-name-directory file)))
|
|
|
10082 (ent (efs-get-file-entry file))
|
|
|
10083 cmd-string)
|
|
|
10084 (or (and (string-equal (downcase host) (downcase nhost))
|
|
|
10085 (string-equal user nuser))
|
|
|
10086 (error "Cannot create hard links between different host user pairs."))
|
|
|
10087 (if (or (null ent) (stringp (car ent))
|
|
|
10088 (not (file-directory-p
|
|
|
10089 (file-name-directory newname))))
|
|
|
10090 (if cont
|
|
|
10091 (efs-call-cont cont 'failed
|
|
|
10092 (format "no such file or directory, %s %s"
|
|
|
10093 file newname) "")
|
|
|
10094 (signal 'file-error
|
|
|
10095 (list "no such file or directory"
|
|
|
10096 file newname)))
|
|
|
10097 (if (or (not ok-if-already-exists)
|
|
|
10098 (numberp ok-if-already-exists))
|
|
|
10099 (efs-barf-or-query-if-file-exists
|
|
|
10100 newname "make hard link" (numberp ok-if-already-exists)))
|
|
|
10101 ;; Do this last, so that hopefully the host type is known.
|
|
|
10102 (let ((host-type (efs-host-type host)))
|
|
|
10103 (if (or (not (memq host-type efs-unix-host-types))
|
|
|
10104 (memq host-type efs-dumb-host-types)
|
|
|
10105 (efs-get-host-property host 'exec-failed))
|
|
|
10106 (error "Unable to make hard links on %s." host)))
|
|
|
10107 (setq cmd-string (concat "ln -f " path " " npath))
|
|
|
10108 (efs-try-ln
|
|
|
10109 host user
|
|
|
10110 (efs-cont () (host user cmd-string file newname abbr cont nowait)
|
|
|
10111 (efs-send-cmd
|
|
|
10112 host user (list 'quote 'site 'exec cmd-string)
|
|
|
10113 (format "Adding to %s name %s" file abbr)
|
|
|
10114 nil
|
|
|
10115 (efs-cont (result line cont-lines) (host user file newname cont)
|
|
|
10116 (if result
|
|
|
10117 (progn
|
|
|
10118 (efs-set-host-property host 'exec-failed t)
|
|
|
10119 (efs-error host user (format "exec: %s" line)))
|
|
|
10120 (efs-save-match-data
|
|
|
10121 (if (string-match "\n200-\\([^\n]*\\)" cont-lines)
|
|
|
10122 (let ((err (substring cont-lines (match-beginning 1)
|
|
|
10123 (match-end 1))))
|
|
|
10124 (if cont
|
|
|
10125 (efs-call-cont cont 'failed err cont-lines)
|
|
|
10126 (efs-error host user err)))
|
|
|
10127 (let ((ent (efs-get-file-entry file)))
|
|
|
10128 (if ent
|
|
|
10129 (let ((nlinks (nthcdr 4 ent))
|
|
|
10130 new-nlinks)
|
|
|
10131 (and (integerp (car nlinks))
|
|
|
10132 (setq new-nlinks (1+ (car nlinks)))
|
|
|
10133 (setcar nlinks new-nlinks))
|
|
|
10134 (apply 'efs-add-file-entry nil newname ent)
|
|
|
10135 (if cont (efs-call-cont cont nil line cont-lines)))
|
|
|
10136 (let ((tbl (efs-get-files-hashtable-entry
|
|
|
10137 (file-name-directory
|
|
|
10138 (directory-file-name newname)))))
|
|
|
10139 (if tbl
|
|
|
10140 (efs-ls
|
|
|
10141 newname
|
|
|
10142 (concat (efs-ls-guess-switches) "d") t t nil
|
|
|
10143 nowait
|
|
|
10144 (efs-cont (listing) (newname cont line cont-lines)
|
|
|
10145 (efs-update-file-info
|
|
|
10146 newname efs-data-buffer-name)
|
|
|
10147 (if cont
|
|
|
10148 (efs-call-cont cont nil line cont-lines))))
|
|
|
10149 (if cont
|
|
|
10150 (efs-call-cont cont nil line cont-lines))))))))))
|
|
|
10151 nowait))
|
|
|
10152 nowait))))
|
|
|
10153
|
|
|
10154 (defun efs-add-name-to-file (file newname &optional ok-if-already-exists)
|
|
|
10155 ;; efs version of add-name-to-file
|
|
|
10156 (efs-add-name-to-file-internal file newname ok-if-already-exists))
|
|
|
10157
|
|
|
10158
|
|
|
10159 ;;;; ==============================================================
|
|
|
10160 ;;;; >9
|
|
|
10161 ;;;; Multiple Host Type Support.
|
|
|
10162 ;;;; The initial host type guessing is done in the PWD code below.
|
|
|
10163 ;;;; If necessary, further guessing is done in the listing parser.
|
|
|
10164 ;;;; ==============================================================
|
|
|
10165
|
|
|
10166
|
|
|
10167 ;;;; --------------------------------------------------------------
|
|
|
10168 ;;;; Functions for setting and retrieving host types.
|
|
|
10169 ;;;; --------------------------------------------------------------
|
|
|
10170
|
|
|
10171 (defun efs-add-host (type host)
|
|
|
10172 "Sets the TYPE of the remote host HOST.
|
|
|
10173 The host type is read with completion so this can be used to obtain a
|
|
|
10174 list of supported host types. HOST must be a string, giving the name of
|
|
|
10175 the host, exactly as given in file names. Setting the host type with
|
|
|
10176 this function is preferable to setting the efs-TYPE-host-regexp, as look up
|
|
|
10177 will be faster. Returns TYPE."
|
|
|
10178 ;; Since internet host names are always case-insensitive, we will cache
|
|
|
10179 ;; them in lower case.
|
|
|
10180 (interactive
|
|
|
10181 (list
|
|
|
10182 (intern
|
|
|
10183 (completing-read "Host type: "
|
|
|
10184 (mapcar
|
|
|
10185 (function (lambda (elt)
|
|
|
10186 (list (symbol-name (car elt)))))
|
|
|
10187 efs-host-type-alist)
|
|
|
10188 nil t))
|
|
|
10189 (read-string "Host: "
|
|
|
10190 (let ((name (or (buffer-file-name)
|
|
|
10191 (and (eq major-mode 'dired-mode)
|
|
|
10192 dired-directory))))
|
|
|
10193 (and name (car (efs-ftp-path name)))))))
|
|
|
10194 (setq host (downcase host))
|
|
|
10195 (efs-set-host-property host 'host-type type)
|
|
|
10196 (prog1
|
|
|
10197 (setq efs-host-cache host
|
|
|
10198 efs-host-type-cache type)
|
|
|
10199 (efs-set-process-host-type host)))
|
|
|
10200
|
|
|
10201 (defun efs-set-process-host-type (host &optional user)
|
|
|
10202 ;; Sets the value of efs-process-host-type so that it is shown
|
|
|
10203 ;; on the mode-line.
|
|
|
10204 (let ((buff-list (buffer-list)))
|
|
|
10205 (save-excursion
|
|
|
10206 (while buff-list
|
|
|
10207 (set-buffer (car buff-list))
|
|
|
10208 (if (equal efs-process-host host)
|
|
|
10209 (setq efs-process-host-type (concat " " (symbol-name
|
|
|
10210 (efs-host-type host))))
|
|
|
10211 (and efs-show-host-type-in-dired
|
|
|
10212 (eq major-mode 'dired-mode)
|
|
|
10213 efs-dired-host-type
|
|
|
10214 (string-equal (downcase
|
|
|
10215 (car (efs-ftp-path default-directory)))
|
|
|
10216 (downcase host))
|
|
|
10217 (if user
|
|
|
10218 (setq efs-dired-listing-type-string
|
|
|
10219 (concat
|
|
|
10220 " "
|
|
|
10221 (symbol-name (efs-listing-type host user))))
|
|
|
10222 (or efs-dired-listing-type-string
|
|
|
10223 (setq efs-dired-listing-type-string
|
|
|
10224 (concat " " (symbol-name (efs-host-type host))))))))
|
|
|
10225 (setq buff-list (cdr buff-list))))))
|
|
|
10226
|
|
|
10227 ;;;; ----------------------------------------------------------------
|
|
|
10228 ;;;; Functions for setting and retrieving listings types.
|
|
|
10229 ;;;; ----------------------------------------------------------------
|
|
|
10230
|
|
|
10231 ;;; listing types??
|
|
|
10232 ;;; These are distinguished from host types, in case some OS's have two
|
|
|
10233 ;;; breeds of listings. e.g. Unix descriptive listings.
|
|
|
10234 ;;; We also use this to support the myriad of DOS ftp servers.
|
|
|
10235
|
|
|
10236
|
|
|
10237 (defun efs-listing-type (host user)
|
|
|
10238 "Returns the type of listing used on HOST by USER.
|
|
|
10239 If there is no entry for a specialized listing, returns the host type."
|
|
|
10240 (or
|
|
|
10241 (efs-get-host-user-property host user 'listing-type)
|
|
|
10242 (efs-host-type host user)))
|
|
|
10243
|
|
|
10244 (defun efs-add-listing-type (type host user)
|
|
|
10245 "Interactively adds the specialized listing type TYPE for HOST and USER
|
|
|
10246 to the listing type cache."
|
|
|
10247 (interactive
|
|
|
10248 (let ((name (or (buffer-file-name)
|
|
|
10249 (and (eq major-mode 'dired-mode)
|
|
|
10250 dired-directory))))
|
|
|
10251 (list
|
|
|
10252 (intern
|
|
|
10253 (completing-read "Listing type: "
|
|
|
10254 (mapcar
|
|
|
10255 (function (lambda (elt)
|
|
|
10256 (list (symbol-name elt))))
|
|
|
10257 efs-listing-types)
|
|
|
10258 nil t))
|
|
|
10259 (read-string "Host: "
|
|
|
10260 (and name (car (efs-ftp-path name))))
|
|
|
10261 (read-string "User: "
|
|
|
10262 (and name (nth 1 (efs-ftp-path name)))))))
|
|
|
10263 (efs-set-host-user-property host user 'listing-type type)
|
|
|
10264 (efs-set-process-host-type host user))
|
|
|
10265
|
|
|
10266 ;;;; --------------------------------------------------------------
|
|
|
10267 ;;;; Auotomagic bug reporting for unrecognized host types.
|
|
|
10268 ;;;; --------------------------------------------------------------
|
|
|
10269
|
|
|
10270 (defun efs-scream-and-yell-1 (host user)
|
|
|
10271 ;; Internal for efs-scream-and-yell.
|
|
|
10272 (with-output-to-temp-buffer "*Help*"
|
|
|
10273 (princ
|
|
|
10274 (format
|
|
|
10275 "efs is unable to identify the remote host type of %s.
|
|
|
10276
|
|
|
10277 Please report this as a bug. It would be very helpful
|
|
|
10278 if your bug report contained at least the PWD command
|
|
|
10279 within the *ftp %s@%s* buffer.
|
|
|
10280 If you know them, also send the operating system
|
|
|
10281 and ftp server types of the remote host." host user host)))
|
|
|
10282 (if (y-or-n-p "Would you like to submit a bug report now? ")
|
|
|
10283 (efs-report-bug host user
|
|
|
10284 "Bug occurred during efs-guess-host-type." t)))
|
|
|
10285
|
|
|
10286 (defun efs-scream-and-yell (host user)
|
|
|
10287 ;; Advertises that something has gone wrong in identifying the host type.
|
|
|
10288 (if (eq (selected-window) (minibuffer-window))
|
|
|
10289 (efs-abort-recursive-edit-and-then 'efs-scream-and-yell-1 host user)
|
|
|
10290 (efs-scream-and-yell-1 host user)
|
|
|
10291 (error "Unable to identify remote host type")))
|
|
|
10292
|
|
|
10293 ;;;; --------------------------------------------------------
|
|
|
10294 ;;;; Guess at the host type using PWD syntax.
|
|
|
10295 ;;;; --------------------------------------------------------
|
|
|
10296
|
|
|
10297 ;; host-type path templates. These should match a pwd performed
|
|
|
10298 ;; as the first command after connecting. They should be as tight
|
|
|
10299 ;; as possible
|
|
|
10300
|
|
|
10301 (defconst efs-unix-path-template "^/")
|
|
|
10302 (defconst efs-apollo-unix-path-template "^//")
|
|
|
10303 (defconst efs-cms-path-template
|
|
|
10304 (concat
|
|
|
10305 "^[-A-Z0-9$*][-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?"
|
|
|
10306 "[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?\\.[0-9][0-9][0-9A-Z]$\\|"
|
|
|
10307 ;; For the SFS version of CMS
|
|
|
10308 "^[-A-Z0-9]+:[-A-Z0-9$*]+\\.$"))
|
|
|
10309
|
|
|
10310 (defconst efs-mvs-path-template "^'?[A-Z][0-9][0-9]?[0-9]?[0-9]?[0-9]?\\.'?")
|
|
|
10311
|
|
|
10312 (defconst efs-guardian-path-template
|
|
|
10313 (concat
|
|
|
10314 "^\\("
|
|
|
10315 "\\\\[A-Z0-9][A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?\\."
|
|
|
10316 "\\)?"
|
|
|
10317 "\\$[A-Z0-9][A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?\\."
|
|
|
10318 "[A-Z][A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?$"))
|
|
|
10319 ;; guardian and cms are very close to overlapping (they don't). Be careful.
|
|
|
10320 (defconst efs-vms-path-template
|
|
|
10321 "^[-A-Z0-9_$]+:\\[[-A-Z0-9_$]+\\(\\.[-A-Z0-9_$]+\\)*\\]$")
|
|
|
10322 (defconst efs-mts-path-template
|
|
|
10323 "^[A-Z0-9._][A-Z0-9._][A-Z0-9._][A-Z0-9._]:$")
|
|
|
10324 (defconst efs-ms-unix-path-template "^[A-Za-z0-9]:/")
|
|
|
10325
|
|
|
10326 ;; Following two are for TI lisp machines. Note that lisp machines
|
|
|
10327 ;; do not have a default directory, but only a default pathname against
|
|
|
10328 ;; which relative pathnames are merged (Jamie tells me).
|
|
|
10329 (defconst efs-ti-explorer-pwd-line-template
|
|
|
10330 (let* ((excluded-chars ":;<>.#\n\r\t\\/a-z ")
|
|
|
10331 (token (concat "[^" excluded-chars "]+")))
|
|
|
10332 (concat "^250 "
|
|
|
10333 token ": " ; host name
|
|
|
10334 token "\\(\\." token "\\)*; " ; directory
|
|
|
10335 "\\(\\*.\\*\\|\\*\\)#\\(\\*\\|>\\)" ; name, ext, version
|
|
|
10336 "$"))) ; "*.*#*" or "*.*#>" or "*#*" or "*#>" or "#*" ...
|
|
|
10337 (defconst efs-ti-twenex-path-template
|
|
|
10338 (let* ((excluded-chars ":;<>.#\n\r\t\\/a-z ")
|
|
|
10339 (token (concat "[^" excluded-chars "]+")))
|
|
|
10340 (concat "^"
|
|
|
10341 token ":" ; host name
|
|
|
10342 "<\\(" token "\\)?\\(\\." token "\\)*>" ; directory
|
|
|
10343 "\\(\\*.\\*\\|\\*\\)" ; name and extension
|
|
|
10344 "$")))
|
|
|
10345
|
|
|
10346 (defconst efs-tops-20-path-template
|
|
|
10347 "^[-A-Z0-9_$]+:<[-A-Z0-9_$]\\(.[-A-Z0-9_$]+\\)*>$")
|
|
|
10348 (defconst efs-pc-path-template
|
|
|
10349 "^[a-zA-Z0-9]:\\\\\\([-_+=a-zA-Z0-9.]+\\\\\\)*[-_+=a-zA-Z0-9.]*$")
|
|
|
10350 (defconst efs-mpe-path-template
|
|
|
10351 (let ((token (concat "[A-Z][A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?"
|
|
|
10352 "[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?")))
|
|
|
10353 (concat
|
|
|
10354 ;; optional session name
|
|
|
10355 "^\\(" token "\\)?,"
|
|
|
10356 ;; username
|
|
|
10357 token "."
|
|
|
10358 ;; account
|
|
|
10359 token ","
|
|
|
10360 ;; group
|
|
|
10361 token "$")))
|
|
|
10362 (defconst efs-vos-path-template
|
|
|
10363 (let ((token "[][@\\^`{}|~\"$+,---./:_a-zA-Z0-9]+"))
|
|
|
10364 (concat
|
|
|
10365 "%" token ; host
|
|
|
10366 "#" token ; disk
|
|
|
10367 "\\(>" token "\\)+" ; directories
|
|
|
10368 )))
|
|
|
10369 (defconst efs-netware-path-template "^[-A-Z0-9_][-A-Z0-9_/]*:/")
|
|
|
10370 ;; Sometimes netware doesn't return a device to a PWD. Then it will be
|
|
|
10371 ;; recognized by the listing parser.
|
|
|
10372
|
|
|
10373 (defconst efs-nos-ve-path-template "^:[A-Z0-9]")
|
|
|
10374 ;; Matches the path for NOS/VE
|
|
|
10375
|
|
|
10376 (defconst efs-mvs-pwd-line-template
|
|
|
10377 ;; Not sure how the PWD parser will do with empty strings, so treate
|
|
|
10378 ;; this as a line regexp.
|
|
|
10379 "^257 \\([Nn]o prefix defined\\|\"\" is working directory\\)")
|
|
|
10380 (defconst efs-cms-pwd-line-template
|
|
|
10381 "^450 No current working directory defined$")
|
|
|
10382 (defconst efs-tops-20-pwd-line-template
|
|
|
10383 "^500 I never heard of the \\(XPWD\\|PWD\\) command\\. Try HELP\\.$")
|
|
|
10384 (defconst efs-dos:ftp-pwd-line-template
|
|
|
10385 "^250 Current working directory is +")
|
|
|
10386 (defconst efs-coke-pwd-line-template "^257 Current balance \\$[0-9]")
|
|
|
10387
|
|
|
10388 (defconst efs-super-dumb-unix-tilde-regexp
|
|
|
10389 "^550 /.*: No such file or directory\\.?$")
|
|
|
10390 (defconst efs-cms-knet-tilde-regexp
|
|
|
10391 "^501 Invalid CMS fileid: ~$")
|
|
|
10392
|
|
|
10393
|
|
|
10394 ;; It might be nice to message users about the host type identified,
|
|
|
10395 ;; but there is so much other messaging going on, it would not be
|
|
|
10396 ;; seen. No point in slowing things down just so users can read
|
|
|
10397 ;; a host type message.
|
|
|
10398
|
|
|
10399 (defun efs-guess-host-type (host user)
|
|
|
10400 "Guess the host type of HOST.
|
|
|
10401 Does a PWD and examines the directory syntax. The PWD is then cached for use
|
|
|
10402 in file name expansion."
|
|
|
10403 (let ((host-type (efs-host-type host))
|
|
|
10404 (key (concat host "/" user "/~"))
|
|
|
10405 syst)
|
|
|
10406 (efs-save-match-data
|
|
|
10407 (if (eq host-type 'unknown)
|
|
|
10408 ;; Note that efs-host-type returns unknown as the default.
|
|
|
10409 ;; Since we don't yet know the host-type, we use the default
|
|
|
10410 ;; version of efs-send-pwd. We compensate if necessary
|
|
|
10411 ;; by looking at the entire line of output.
|
|
|
10412 (let* ((result (efs-send-pwd nil host user))
|
|
|
10413 (dir (car result))
|
|
|
10414 (line (cdr result)))
|
|
|
10415 (cond
|
|
|
10416
|
|
|
10417 ;; First sift through process lines to see if we recognize
|
|
|
10418 ;; any pwd errors, or full line messages.
|
|
|
10419
|
|
|
10420 ;; CMS
|
|
|
10421 ((string-match efs-cms-pwd-line-template line)
|
|
|
10422 (setq host-type (efs-add-host 'cms host)
|
|
|
10423 dir (concat "/" (if (> (length user) 8)
|
|
|
10424 (substring user 0 8)
|
|
|
10425 user)
|
|
|
10426 ".191"))
|
|
|
10427 (message
|
|
|
10428 "Unable to determine a \"home\" CMS minidisk. Assuming %s"
|
|
|
10429 dir)
|
|
|
10430 (sit-for 1))
|
|
|
10431
|
|
|
10432 ;; TOPS-20
|
|
|
10433 ((string-match efs-tops-20-pwd-line-template line)
|
|
|
10434 (setq host-type (efs-add-host 'tops-20 host)
|
|
|
10435 dir (car (efs-send-pwd 'tops-20 host user))))
|
|
|
10436
|
|
|
10437 ;; TI-EXPLORER lisp machine. pwd works here, but the output
|
|
|
10438 ;; needs to be specially parsed since spaces separate
|
|
|
10439 ;; hostnames from dirs from filenames.
|
|
|
10440 ((string-match efs-ti-explorer-pwd-line-template line)
|
|
|
10441 (setq host-type (efs-add-host 'ti-explorer host)
|
|
|
10442 dir (substring line 4)))
|
|
|
10443
|
|
|
10444 ;; FTP Software's DOS Server
|
|
|
10445 ((string-match efs-dos:ftp-pwd-line-template line)
|
|
|
10446 (setq host-type (efs-add-host 'dos host)
|
|
|
10447 dir (substring line (match-end 0)))
|
|
|
10448 (efs-add-listing-type 'dos:ftp host user))
|
|
|
10449
|
|
|
10450 ;; MVS
|
|
|
10451 ((string-match efs-mvs-pwd-line-template line)
|
|
|
10452 (setq host-type (efs-add-host 'mvs host)
|
|
|
10453 dir "")) ; "" will convert to /, which is always
|
|
|
10454 ; the mvs home dir.
|
|
|
10455
|
|
|
10456 ;; COKE
|
|
|
10457 ((string-match efs-coke-pwd-line-template line)
|
|
|
10458 (setq host-type (efs-add-host 'coke host)
|
|
|
10459 dir "/"))
|
|
|
10460
|
|
|
10461 ;; Try to get tilde.
|
|
|
10462 ((null dir)
|
|
|
10463 (let ((tilde (nth 1 (efs-send-cmd
|
|
|
10464 host user (list 'get "~" "/dev/null")))))
|
|
|
10465 (cond
|
|
|
10466 ;; super dumb unix
|
|
|
10467 ((string-match efs-super-dumb-unix-tilde-regexp tilde)
|
|
|
10468 (setq dir (car (efs-send-pwd 'super-dumb-unix host user))
|
|
|
10469 host-type (efs-add-host 'super-dumb-unix host)))
|
|
|
10470
|
|
|
10471 ;; Try for cms-knet
|
|
|
10472 ((string-match efs-cms-knet-tilde-regexp tilde)
|
|
|
10473 (setq dir (car (efs-send-pwd 'cms-knet host user))
|
|
|
10474 host-type (efs-add-host 'cms-knet host)))
|
|
|
10475
|
|
|
10476 ;; We don't know. Scream and yell.
|
|
|
10477 (efs-scream-and-yell host user))))
|
|
|
10478
|
|
|
10479 ;; Now look at dir to determine host type
|
|
|
10480
|
|
|
10481 ;; try for UN*X-y type stuff
|
|
|
10482 ((string-match efs-unix-path-template dir)
|
|
|
10483 (if
|
|
|
10484 ;; Check for apollo, so we know not to short-circuit //.
|
|
|
10485 (string-match efs-apollo-unix-path-template dir)
|
|
|
10486 (progn
|
|
|
10487 (setq host-type (efs-add-host 'apollo-unix host))
|
|
|
10488 (efs-add-listing-type 'unix:unknown host user))
|
|
|
10489 ;; could be ka9q, dos-distinct, plus any of the unix breeds,
|
|
|
10490 ;; except apollo.
|
|
|
10491 (if (setq syst (efs-get-syst host user))
|
|
|
10492 (let ((case-fold-search t))
|
|
|
10493 (cond
|
|
|
10494 ((string-match "\\bNetware\\b" syst)
|
|
|
10495 (setq host-type (efs-add-host 'netware host)))
|
|
|
10496 ((string-match "^Plan 9" syst)
|
|
|
10497 (setq host-type (efs-add-host 'plan9 host)))
|
|
|
10498 ((string-match "^UNIX" syst)
|
|
|
10499 (setq host-type (efs-add-host 'unix host))
|
|
|
10500 (efs-add-listing-type 'unix:unknown host user)))))))
|
|
|
10501
|
|
|
10502 ;; try for VMS
|
|
|
10503 ((string-match efs-vms-path-template dir)
|
|
|
10504 (setq host-type (efs-add-host 'vms host)))
|
|
|
10505
|
|
|
10506 ;; try for MTS
|
|
|
10507 ((string-match efs-mts-path-template dir)
|
|
|
10508 (setq host-type (efs-add-host 'mts host)))
|
|
|
10509
|
|
|
10510 ;; try for CMS
|
|
|
10511 ((string-match efs-cms-path-template dir)
|
|
|
10512 (setq host-type (efs-add-host 'cms host)))
|
|
|
10513
|
|
|
10514 ;; try for Tandem's guardian OS
|
|
|
10515 ((string-match efs-guardian-path-template dir)
|
|
|
10516 (setq host-type (efs-add-host 'guardian host)))
|
|
|
10517
|
|
|
10518 ;; Try for TOPS-20. pwd doesn't usually work for tops-20
|
|
|
10519 ;; But who knows???
|
|
|
10520 ((string-match efs-tops-20-path-template dir)
|
|
|
10521 (setq host-type (efs-add-host 'tops-20 host)))
|
|
|
10522
|
|
|
10523 ;; Try for DOS or OS/2.
|
|
|
10524 ((string-match efs-pc-path-template dir)
|
|
|
10525 (let ((syst (efs-get-syst host user))
|
|
|
10526 (case-fold-search t))
|
|
|
10527 (if (and syst (string-match "^OS/2 " syst))
|
|
|
10528 (setq host-type (efs-add-host 'os2 host))
|
|
|
10529 (setq host-type (efs-add-host 'dos host)))))
|
|
|
10530
|
|
|
10531 ;; try for TI-TWENEX lisp machine
|
|
|
10532 ((string-match efs-ti-twenex-path-template dir)
|
|
|
10533 (setq host-type (efs-add-host 'ti-twenex host)))
|
|
|
10534
|
|
|
10535 ;; try for MPE
|
|
|
10536 ((string-match efs-mpe-path-template dir)
|
|
|
10537 (setq host-type (efs-add-host 'mpe host)))
|
|
|
10538
|
|
|
10539 ;; try for VOS
|
|
|
10540 ((string-match efs-vos-path-template dir)
|
|
|
10541 (setq host-type (efs-add-host 'vos host)))
|
|
|
10542
|
|
|
10543 ;; try for the microsoft server in unix mode
|
|
|
10544 ((string-match efs-ms-unix-path-template dir)
|
|
|
10545 (setq host-type (efs-add-host 'ms-unix host)))
|
|
|
10546
|
|
|
10547 ;; Netware?
|
|
|
10548 ((string-match efs-netware-path-template dir)
|
|
|
10549 (setq host-type (efs-add-host 'netware host)))
|
|
|
10550
|
|
|
10551 ;; Try for MVS
|
|
|
10552 ((string-match efs-mvs-path-template dir)
|
|
|
10553 (if (string-match "^'.+'$" dir)
|
|
|
10554 ;; broken MVS PWD quoting
|
|
|
10555 (setq dir (substring dir 1 -1)))
|
|
|
10556 (setq host-type (efs-add-host 'mvs host)))
|
|
|
10557
|
|
|
10558 ;; Try for NOS/VE
|
|
|
10559 ((string-match efs-nos-ve-path-template dir)
|
|
|
10560 (setq host-type (efs-add-host 'nos-ve host)))
|
|
|
10561
|
|
|
10562 ;; We don't know. Scream and yell.
|
|
|
10563 (t
|
|
|
10564 (efs-scream-and-yell host user)))
|
|
|
10565
|
|
|
10566 ;; Now that we have done a pwd, might as well put it in
|
|
|
10567 ;; the expand-dir hashtable.
|
|
|
10568 (if dir
|
|
|
10569 (efs-put-hash-entry
|
|
|
10570 key
|
|
|
10571 (efs-internal-directory-file-name
|
|
|
10572 (efs-fix-path host-type dir 'reverse))
|
|
|
10573 efs-expand-dir-hashtable
|
|
|
10574 (memq host-type efs-case-insensitive-host-types))))
|
|
|
10575
|
|
|
10576 ;; host-type has been identified by regexp, set the mode-line.
|
|
|
10577 (efs-set-process-host-type host user)
|
|
|
10578
|
|
|
10579 ;; Some special cases, where we need to store the cwd on login.
|
|
|
10580 (if (not (efs-hash-entry-exists-p
|
|
|
10581 key efs-expand-dir-hashtable))
|
|
|
10582 (cond
|
|
|
10583 ;; CMS: We will be doing cd's, so we'd better make sure that
|
|
|
10584 ;; we know where home is.
|
|
|
10585 ((eq host-type 'cms)
|
|
|
10586 (let* ((res (efs-send-pwd 'cms host user))
|
|
|
10587 (dir (car res))
|
|
|
10588 (line (cdr res)))
|
|
|
10589 (if (and dir (not (string-match
|
|
|
10590 efs-cms-pwd-line-template line)))
|
|
|
10591 (setq dir (concat "/" dir))
|
|
|
10592 (setq dir (concat "/" (if (> (length user) 8)
|
|
|
10593 (substring user 0 8)
|
|
|
10594 user)
|
|
|
10595 ".191"))
|
|
|
10596 (message
|
|
|
10597 "Unable to determine a \"home\" CMS minidisk. Assuming %s"
|
|
|
10598 dir))
|
|
|
10599 (efs-put-hash-entry
|
|
|
10600 key dir efs-expand-dir-hashtable
|
|
|
10601 (memq 'cms efs-case-insensitive-host-types))))
|
|
|
10602 ;; MVS: pwd doesn't work in the root directory, so we stuff this
|
|
|
10603 ;; into the hashtable manually.
|
|
|
10604 ((eq host-type 'mvs)
|
|
|
10605 (efs-put-hash-entry key "/" efs-expand-dir-hashtable))
|
|
|
10606 ))))))
|
|
|
10607
|
|
|
10608
|
|
|
10609 ;;;; -----------------------------------------------------------
|
|
|
10610 ;;;; efs-autoloads
|
|
|
10611 ;;;; These provide the entry points for the non-unix packages.
|
|
|
10612 ;;;; -----------------------------------------------------------
|
|
|
10613
|
|
|
10614 (efs-autoload 'efs-fix-path vms "efs-vms")
|
|
|
10615 (efs-autoload 'efs-fix-path mts "efs-mts")
|
|
|
10616 (efs-autoload 'efs-fix-path cms "efs-cms")
|
|
|
10617 (efs-autoload 'efs-fix-path ti-explorer "efs-ti-explorer")
|
|
|
10618 (efs-autoload 'efs-fix-path ti-twenex "efs-ti-twenex")
|
|
|
10619 (efs-autoload 'efs-fix-path dos "efs-pc")
|
|
|
10620 (efs-autoload 'efs-fix-path mvs "efs-mvs")
|
|
|
10621 (efs-autoload 'efs-fix-path tops-20 "efs-tops-20")
|
|
|
10622 (efs-autoload 'efs-fix-path mpe "efs-mpe")
|
|
|
10623 (efs-autoload 'efs-fix-path os2 "efs-pc")
|
|
|
10624 (efs-autoload 'efs-fix-path vos "efs-vos")
|
|
|
10625 (efs-autoload 'efs-fix-path ms-unix "efs-ms-unix")
|
|
|
10626 (efs-autoload 'efs-fix-path netware "efs-netware")
|
|
|
10627 (efs-autoload 'efs-fix-path cms-knet "efs-cms-knet")
|
|
|
10628 (efs-autoload 'efs-fix-path guardian "efs-guardian")
|
|
|
10629 (efs-autoload 'efs-fix-path nos-ve "efs-nos-ve")
|
|
|
10630
|
|
|
10631 (efs-autoload 'efs-fix-dir-path vms "efs-vms")
|
|
|
10632 (efs-autoload 'efs-fix-dir-path mts "efs-mts")
|
|
|
10633 (efs-autoload 'efs-fix-dir-path cms "efs-cms")
|
|
|
10634 (efs-autoload 'efs-fix-dir-path ti-explorer "efs-ti-explorer")
|
|
|
10635 (efs-autoload 'efs-fix-dir-path ti-twenex "efs-ti-twenex")
|
|
|
10636 (efs-autoload 'efs-fix-dir-path dos "efs-pc")
|
|
|
10637 (efs-autoload 'efs-fix-dir-path mvs "efs-mvs")
|
|
|
10638 (efs-autoload 'efs-fix-dir-path tops-20 "efs-tops-20")
|
|
|
10639 (efs-autoload 'efs-fix-dir-path mpe "efs-mpe")
|
|
|
10640 (efs-autoload 'efs-fix-dir-path os2 "efs-pc")
|
|
|
10641 (efs-autoload 'efs-fix-dir-path vos "efs-vos")
|
|
|
10642 (efs-autoload 'efs-fix-dir-path hell "efs-hell")
|
|
|
10643 (efs-autoload 'efs-fix-dir-path ms-unix "efs-ms-unix")
|
|
|
10644 (efs-autoload 'efs-fix-dir-path netware "efs-netware")
|
|
|
10645 (efs-autoload 'efs-fix-dir-path plan9 "efs-plan9")
|
|
|
10646 (efs-autoload 'efs-fix-dir-path cms-knet "efs-cms-knet")
|
|
|
10647 (efs-autoload 'efs-fix-dir-path guardian "efs-guardian")
|
|
|
10648 (efs-autoload 'efs-fix-dir-path nos-ve "efs-nos-ve")
|
|
|
10649 (efs-autoload 'efs-fix-dir-path coke "efs-coke")
|
|
|
10650
|
|
|
10651 ;; A few need to autoload a pwd function
|
|
|
10652 (efs-autoload 'efs-send-pwd tops-20 "efs-tops-20")
|
|
|
10653 (efs-autoload 'efs-send-pwd cms-knet "efs-cms-knet")
|
|
|
10654 (efs-autoload 'efs-send-pwd ti-explorer "efs-ti-explorer")
|
|
|
10655 (efs-autoload 'efs-send-pwd hell "efs-hell")
|
|
|
10656 (efs-autoload 'efs-send-pwd mvs "efs-mvs")
|
|
|
10657 (efs-autoload 'efs-send-pwd coke "efs-coke")
|
|
|
10658
|
|
|
10659 ;; A few packages are loaded by the listing parser.
|
|
|
10660 (efs-autoload 'efs-parse-listing ka9q "efs-ka9q")
|
|
|
10661 (efs-autoload 'efs-parse-listing unix:dl "efs-dl")
|
|
|
10662 (efs-autoload 'efs-parse-listing dos-distinct "efs-dos-distinct")
|
|
|
10663 (efs-autoload 'efs-parse-listing hell "efs-hell")
|
|
|
10664 (efs-autoload 'efs-parse-listing netware "efs-netware")
|
|
|
10665
|
|
|
10666 ;; Packages that need to autoload for child-lookup
|
|
|
10667 (efs-autoload 'efs-allow-child-lookup plan9 "efs-plan9")
|
|
|
10668 (efs-autoload 'efs-allow-child-lookup coke "efs-coke")
|
|
|
10669
|
|
|
10670 ;; Packages that need to autoload for file-exists-p and file-directory-p
|
|
|
10671 (efs-autoload 'efs-internal-file-exists-p guardian "efs-guardian")
|
|
|
10672 (efs-autoload 'efs-internal-file-directory-p guardian "efs-guardian")
|
|
|
10673
|
|
|
10674
|
|
|
10675
|
|
|
10676 ;;;; ============================================================
|
|
|
10677 ;;;; >10
|
|
|
10678 ;;;; Attaching onto the appropriate Emacs version
|
|
|
10679 ;;;; ============================================================
|
|
|
10680
|
|
|
10681 ;;;; -------------------------------------------------------------------
|
|
|
10682 ;;;; Connect to various hooks.
|
|
|
10683 ;;;; -------------------------------------------------------------------
|
|
|
10684
|
|
|
10685 (or (memq 'efs-set-buffer-mode find-file-hooks)
|
|
|
10686 (setq find-file-hooks
|
|
|
10687 (cons 'efs-set-buffer-mode find-file-hooks)))
|
|
|
10688
|
|
|
10689 ;;; We are using our own dired.el, so this doesn't depend on Emacs flavour.
|
|
|
10690
|
|
|
10691 (if (featurep 'dired)
|
|
|
10692 (require 'efs-dired)
|
|
|
10693 (add-hook 'dired-load-hook (function
|
|
|
10694 (lambda ()
|
|
|
10695 (require 'efs-dired)))))
|
|
|
10696
|
|
|
10697 ;;;; ------------------------------------------------------------
|
|
|
10698 ;;;; Add to minor-mode-alist.
|
|
|
10699 ;;;; ------------------------------------------------------------
|
|
|
10700
|
|
|
10701 (or (assq 'efs-process-host-type minor-mode-alist)
|
|
|
10702 (if (assq 'dired-sort-mode minor-mode-alist)
|
|
|
10703 (let ((our-list
|
|
|
10704 (nconc
|
|
|
10705 (delq nil
|
|
|
10706 (list (assq 'dired-sort-mode minor-mode-alist)
|
|
|
10707 (assq 'dired-subdir-omit minor-mode-alist)
|
|
|
10708 (assq 'dired-marker-stack minor-mode-alist)))
|
|
|
10709 (list '(efs-process-host-type efs-process-host-type)
|
|
|
10710 '(efs-dired-listing-type
|
|
|
10711 efs-dired-listing-type-string))))
|
|
|
10712 (old-list (delq
|
|
|
10713 (assq 'efs-process-host-type minor-mode-alist)
|
|
|
10714 (delq
|
|
|
10715 (assq 'efs-dired-listing-type minor-mode-alist)
|
|
|
10716 minor-mode-alist))))
|
|
|
10717 (setq minor-mode-alist nil)
|
|
|
10718 (while old-list
|
|
|
10719 (or (assq (car (car old-list)) our-list)
|
|
|
10720 (setq minor-mode-alist (nconc minor-mode-alist
|
|
|
10721 (list (car old-list)))))
|
|
|
10722 (setq old-list (cdr old-list)))
|
|
|
10723 (setq minor-mode-alist (nconc our-list minor-mode-alist)))
|
|
|
10724 (setq minor-mode-alist
|
|
|
10725 (nconc
|
|
|
10726 (list '(efs-process-host-type efs-process-host-type)
|
|
|
10727 '(efs-dired-listing-type efs-dired-listing-type-string))
|
|
|
10728 minor-mode-alist))))
|
|
|
10729
|
|
|
10730 ;;;; ------------------------------------------------------------
|
|
|
10731 ;;;; File name handlers
|
|
|
10732 ;;;; ------------------------------------------------------------
|
|
|
10733
|
|
|
10734 (defun efs-file-handler-function (operation &rest args)
|
|
|
10735 "Function to call special file handlers for remote files."
|
|
|
10736 (let ((handler (get operation 'efs)))
|
|
|
10737 (if handler
|
|
|
10738 (apply handler args)
|
|
|
10739 (let ((inhibit-file-name-handlers
|
|
|
10740 (cons 'efs-file-handler-function
|
|
|
10741 (and (eq inhibit-file-name-operation operation)
|
|
|
10742 inhibit-file-name-handlers)))
|
|
|
10743 (inhibit-file-name-operation operation))
|
|
|
10744 (apply operation args)))))
|
|
|
10745
|
|
|
10746 (defun efs-sifn-handler-function (operation &rest args)
|
|
|
10747 ;; Handler function for substitute-in-file-name
|
|
|
10748 (if (eq operation 'substitute-in-file-name)
|
|
|
10749 (apply 'efs-substitute-in-file-name args)
|
|
|
10750 (let ((inhibit-file-name-handlers
|
|
|
10751 (cons 'efs-sifn-handler-function
|
|
|
10752 (and (eq operation inhibit-file-name-operation)
|
|
|
10753 inhibit-file-name-handlers)))
|
|
|
10754 (inhibit-file-name-operation operation))
|
|
|
10755 (apply operation args))))
|
|
|
10756
|
|
|
10757 ;; Yes, this is what it looks like. I'm defining the handler to run our
|
|
|
10758 ;; version whenever there is an environment variable.
|
|
|
10759
|
|
|
10760 (nconc file-name-handler-alist
|
|
|
10761 (list
|
|
|
10762 (cons "\\(^\\|[^$]\\)\\(\\$\\$\\)*\\$[{a-zA-Z0-9]"
|
|
|
10763 'efs-sifn-handler-function)))
|
|
|
10764
|
|
|
10765 ;;;; ------------------------------------------------------------
|
|
|
10766 ;;;; Necessary overloads.
|
|
|
10767 ;;;; ------------------------------------------------------------
|
|
|
10768
|
|
|
10769 ;;; The following functions are overloaded, instead of extended via
|
|
|
10770 ;;; the file-name-handler-alist. For various reasons, the
|
|
|
10771 ;;; file-name-handler-alist doesn't work for them. It would be nice if
|
|
|
10772 ;;; this list could be shortened in the future.
|
|
|
10773
|
|
|
10774 ;; File name exansion. It is not until _after_ a file name has been
|
|
|
10775 ;; expanded that it is reasonable to test it for a file name handler.
|
|
|
10776 (efs-overwrite-fn "efs" 'expand-file-name)
|
|
|
10777
|
|
|
10778 ;; Loading lisp files. The problem with using the file-name-handler-alist
|
|
|
10779 ;; here is that we don't know what is to be handled, until after searching
|
|
|
10780 ;; the load-path. The solution is to change the C code for Fload.
|
|
|
10781 ;; A patch to do this has been written by Jay Adams <jka@ece.cmu.edu>.
|
|
|
10782 (efs-overwrite-fn "efs" 'load)
|
|
|
10783 (efs-overwrite-fn "efs" 'require)
|
|
|
10784
|
|
|
10785 ;;;; ------------------------------------------------------------
|
|
|
10786 ;;;; Install the file handlers for efs-file-handler-function.
|
|
|
10787 ;;;; ------------------------------------------------------------
|
|
|
10788
|
|
|
10789 ;; I/O
|
|
|
10790 (put 'insert-file-contents 'efs 'efs-insert-file-contents)
|
|
|
10791 (put 'write-region 'efs 'efs-write-region)
|
|
|
10792 (put 'directory-files 'efs 'efs-directory-files)
|
|
|
10793 (put 'list-directory 'efs 'efs-list-directory)
|
|
|
10794 (put 'insert-directory 'efs 'efs-insert-directory)
|
|
|
10795 (put 'recover-file 'efs 'efs-recover-file)
|
|
|
10796 ;; file properties
|
|
|
10797 (put 'file-directory-p 'efs 'efs-file-directory-p)
|
|
|
10798 (put 'file-writable-p 'efs 'efs-file-writable-p)
|
|
|
10799 (put 'file-readable-p 'efs 'efs-file-readable-p)
|
|
|
10800 (put 'file-executable-p 'efs 'efs-file-executable-p)
|
|
|
10801 (put 'file-symlink-p 'efs 'efs-file-symlink-p)
|
|
|
10802 (put 'file-attributes 'efs 'efs-file-attributes)
|
|
|
10803 (put 'file-exists-p 'efs 'efs-file-exists-p)
|
|
|
10804 (put 'file-accessible-directory-p 'efs 'efs-file-accessible-directory-p)
|
|
|
10805 ;; manipulating file names
|
|
|
10806 (put 'file-name-directory 'efs 'efs-file-name-directory)
|
|
|
10807 (put 'file-name-nondirectory 'efs 'efs-file-name-nondirectory)
|
|
|
10808 (put 'file-name-as-directory 'efs 'efs-file-name-as-directory)
|
|
|
10809 (put 'directory-file-name 'efs 'efs-directory-file-name)
|
|
|
10810 (put 'abbreviate-file-name 'efs 'efs-abbreviate-file-name)
|
|
|
10811 (put 'file-name-sans-versions 'efs 'efs-file-name-sans-versions)
|
|
|
10812 (put 'unhandled-file-name-directory 'efs 'efs-unhandled-file-name-directory)
|
|
|
10813 (put 'diff-latest-backup-file 'efs 'efs-diff-latest-backup-file)
|
|
|
10814 (put 'file-truename 'efs 'efs-file-truename)
|
|
|
10815 ;; modtimes
|
|
|
10816 (put 'verify-visited-file-modtime 'efs 'efs-verify-visited-file-modtime)
|
|
|
10817 (put 'file-newer-than-file-p 'efs 'efs-file-newer-than-file-p)
|
|
|
10818 (put 'set-visited-file-modtime 'efs 'efs-set-visited-file-modtime)
|
|
|
10819 ;; file modes
|
|
|
10820 (put 'set-file-modes 'efs 'efs-set-file-modes)
|
|
|
10821 (put 'file-modes 'efs 'efs-file-modes)
|
|
|
10822 ;; buffers
|
|
|
10823 (put 'backup-buffer 'efs 'efs-backup-buffer)
|
|
|
10824 (put 'get-file-buffer 'efs 'efs-get-file-buffer)
|
|
|
10825 (put 'create-file-buffer 'efs 'efs-create-file-buffer)
|
|
|
10826 ;; creating and removing files
|
|
|
10827 (put 'delete-file 'efs 'efs-delete-file)
|
|
|
10828 (put 'copy-file 'efs 'efs-copy-file)
|
|
|
10829 (put 'rename-file 'efs 'efs-rename-file)
|
|
|
10830 (put 'file-local-copy 'efs 'efs-file-local-copy)
|
|
|
10831 (put 'make-directory-internal 'efs 'efs-make-directory-internal)
|
|
|
10832 (put 'delete-directory 'efs 'efs-delete-directory)
|
|
|
10833 (put 'add-name-to-file 'efs 'efs-add-name-to-file)
|
|
|
10834 (put 'make-symbolic-link 'efs 'efs-make-symbolic-link)
|
|
|
10835 ;; file name completion
|
|
|
10836 (put 'file-name-completion 'efs 'efs-file-name-completion)
|
|
|
10837 (put 'file-name-all-completions 'efs 'efs-file-name-all-completions)
|
|
|
10838
|
|
|
10839 ;;;; ------------------------------------------------------------
|
|
|
10840 ;;;; Finally run any load-hooks.
|
|
|
10841 ;;;; ------------------------------------------------------------
|
|
|
10842
|
|
|
10843 (run-hooks 'efs-load-hook)
|
|
|
10844
|
|
|
10845 ;;; end of efs.el
|
