|
22
|
1 ;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
3 ;;
|
|
|
4 ;; File: efs.el
|
|
|
5 ;; Release: $efs release: 1.15 $
|
|
42
|
6 ;; Version: #Revision: 1.56 $
|
|
22
|
7 ;; RCS:
|
|
|
8 ;; Description: Transparent FTP support for the original GNU Emacs
|
|
48
|
9 ;; from FSF and XEmacs
|
|
22
|
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 ;;;
|
|
40
|
76 ;;; If you have any problems with efs, please read this section
|
|
|
77 ;;; *before* submitting a bug report.
|
|
22
|
78
|
|
|
79 ;;; Installation:
|
|
|
80 ;;;
|
|
|
81 ;;; For byte compiling the efs package, a Makefile is provided.
|
|
|
82 ;;; You should follow the instructions at the top of the Makefile.
|
|
|
83 ;;; If you have any problems, please let us know so that we can fix
|
|
|
84 ;;; them for other users. Don't even consider using efs without
|
|
|
85 ;;; byte compiling it. It will be far too slow.
|
|
|
86 ;;;
|
|
|
87 ;;; If you decide to byte compile efs by hand, it is important that
|
|
|
88 ;;; the file efs-defun.el be byte compiled first, followed by efs.el.
|
|
|
89 ;;; The other files may be byte compiled in any order.
|
|
|
90 ;;;
|
|
|
91 ;;; To use efs, simply put the byte compiled files in your load path
|
|
|
92 ;;; and add
|
|
|
93 ;;;
|
|
|
94 ;;; (require 'efs)
|
|
|
95 ;;;
|
|
24
|
96 ;;; in your .emacs file. Note this takes awhile, and some users have
|
|
|
97 ;;; found this to be unbearably slow. Therefore ...
|
|
22
|
98 ;;;
|
|
|
99 ;;; If you would like efs to be autoloaded when you attempt to access
|
|
|
100 ;;; a remote file, put
|
|
|
101 ;;;
|
|
|
102 ;;; (require 'efs-auto)
|
|
|
103 ;;;
|
|
|
104 ;;; in your .emacs file. Note that there are some limitations associated
|
|
|
105 ;;; with autoloading efs. A discussion of them is given at the top of
|
|
|
106 ;;; efs-auto.el.
|
|
|
107
|
|
|
108 ;;; Configuration variables:
|
|
|
109 ;;;
|
|
|
110 ;;; It is important that you read through the section on user customization
|
|
|
111 ;;; variables (search forward for the string ">>>"). If your local network
|
|
|
112 ;;; is not fully connected to the internet, but accesses the internet only
|
|
|
113 ;;; via a gateway, then it is vital to set the appropriate variables to
|
|
|
114 ;;; inform efs about the geometry of your local network. Also, see the
|
|
|
115 ;;; paragraph on gateways below.
|
|
|
116
|
|
|
117 ;;; Usage:
|
|
|
118 ;;;
|
|
|
119 ;;; Once installed, efs operates largely transparently. All files
|
|
|
120 ;;; normally accessible to you on the internet, become part of a large
|
|
|
121 ;;; virtual file system. These files are accessed using an extended
|
|
|
122 ;;; file name syntax. To access file <path> on remote host <host> by
|
|
|
123 ;;; logging in as user <user>, you simply specify the full path of the
|
|
|
124 ;;; file as /<user>@<host>:<path>. Nearly all GNU Emacs file handling
|
|
|
125 ;;; functions work for remote files. It is not possible to access
|
|
|
126 ;;; remote files using shell commands in an emacs *shell* buffer, as such
|
|
|
127 ;;; commands are passed directly to the shell, and not handled by emacs.
|
|
|
128 ;;; FTP is the underlying utility that efs uses to operate on remote files.
|
|
|
129 ;;;
|
|
|
130 ;;; For example, if find-file is given a filename of:
|
|
|
131 ;;;
|
|
|
132 ;;; /ange@anorman:/tmp/notes
|
|
|
133 ;;;
|
|
|
134 ;;; then efs will spawn an FTP process, connect to the host 'anorman' as
|
|
|
135 ;;; user 'ange', get the file '/tmp/notes' and pop up a buffer containing the
|
|
|
136 ;;; contents of that file as if it were on the local file system. If efs
|
|
|
137 ;;; needed a password to connect then it would prompt the user in the
|
|
|
138 ;;; minibuffer. For further discussion of the efs path syntax, see the
|
|
|
139 ;;; paragraph on extended file name syntax below.
|
|
|
140
|
|
|
141 ;;; Ports:
|
|
|
142 ;;;
|
|
|
143 ;;; efs supports the use of nonstandard ports on remote hosts.
|
|
|
144 ;;; To specify that port <port> should be used, give the host name as
|
|
|
145 ;;; host#<port>. Host names may be given in this form anywhere that efs
|
|
|
146 ;;; normally expects a host name. This includes in the .netrc file.
|
|
|
147 ;;; Logically, efs treats different ports to correspond to different
|
|
|
148 ;;; remote hosts.
|
|
|
149
|
|
|
150 ;;; Extended filename syntax:
|
|
|
151 ;;;
|
|
|
152 ;;; The default full efs path syntax is
|
|
|
153 ;;;
|
|
|
154 ;;; /<user>@<host>#<port>:<path>
|
|
|
155 ;;;
|
|
|
156 ;;; Both the `#<port>' and `<user>@' may be omitted.
|
|
|
157 ;;;
|
|
|
158 ;;; If the `#<port>' is omitted, then the default port is taken to be 21,
|
|
|
159 ;;; the usual FTP port. For most users, the port syntax will only
|
|
|
160 ;;; very rarely be necessary.
|
|
|
161 ;;;
|
|
|
162 ;;; If the `<user>@' is omitted, then efs will use a default user. If a
|
|
|
163 ;;; login token is specified in your .netrc file, then this will be used as
|
|
|
164 ;;; the default user for <host>. Otherwise, it is determined based on the
|
|
|
165 ;;; value of the variable efs-default-user.
|
|
|
166 ;;;
|
|
|
167 ;;; This efs path syntax can be customised to a certain extent by
|
|
|
168 ;;; changing a number of variables in the subsection Internal Variables.
|
|
|
169 ;;; To undertake such a customization requires some knowledge about the
|
|
|
170 ;;; internal workings of efs.
|
|
|
171
|
|
|
172 ;;; Passwords:
|
|
|
173 ;;;
|
|
|
174 ;;; A password is required for each host / user pair. This will be
|
|
|
175 ;;; prompted for when needed, unless already set by calling
|
|
|
176 ;;; efs-set-passwd, or specified in a *valid* ~/.netrc file.
|
|
|
177 ;;;
|
|
|
178 ;;; When efs prompts for a password, it provides defaults from its
|
|
|
179 ;;; cache of currently known passwords. The defaults are ordered such
|
|
|
180 ;;; that passwords for accounts which have the same user name as the
|
|
|
181 ;;; login which is currently underway have priority. You can cycle
|
|
|
182 ;;; through your list of defaults with C-n to cycle forwards and C-p
|
|
|
183 ;;; to cycle backwards. The list is circular.
|
|
|
184
|
|
|
185 ;;; Passwords for user "anonymous":
|
|
|
186 ;;;
|
|
|
187 ;;; Passwords for the user "anonymous" (or "ftp") are handled
|
|
|
188 ;;; specially. The variable efs-generate-anonymous-password controls
|
|
|
189 ;;; what happens. If the value of this variable is a string, then this
|
|
|
190 ;;; is used as the password; if non-nil, then a password is created
|
|
|
191 ;;; from the name of the user and the hostname of the machine on which
|
|
|
192 ;;; GNU Emacs is running; if nil (the default) then the user is
|
|
|
193 ;;; prompted for a password as normal.
|
|
|
194
|
|
|
195 ;;; "Dumb" UNIX hosts:
|
|
|
196 ;;;
|
|
|
197 ;;; The FTP servers on some UNIX machines have problems if the "ls"
|
|
|
198 ;;; command is used. efs will try to correct for this automatically,
|
|
|
199 ;;; and send the "dir" command instead. If it fails, you can call the
|
|
|
200 ;;; function efs-add-host, and give the host type as dumb-unix. Note
|
|
|
201 ;;; that this change will take effect for the current GNU Emacs
|
|
|
202 ;;; session only. To make this specification for future emacs
|
|
|
203 ;;; sessions, put
|
|
|
204 ;;;
|
|
|
205 ;;; (efs-add-host 'dumb-unix "hostname")
|
|
|
206 ;;;
|
|
|
207 ;;; in your .emacs file. Also, please report any failure to automatically
|
|
|
208 ;;; recognize dumb unix to the "bugs" address given below, so that we can
|
|
|
209 ;;; fix the auto recognition code.
|
|
|
210
|
|
|
211 ;;; File name completion:
|
|
|
212 ;;;
|
|
|
213 ;;; Full file-name completion is supported on every type of remote
|
|
|
214 ;;; host. To do filename completion, efs needs a listing from the
|
|
|
215 ;;; remote host. Therefore, for very slow connections, it might not
|
|
|
216 ;;; save any time. However, the listing is cached, so subsequent uses
|
|
|
217 ;;; of file-name completion will be just as fast as for local file
|
|
|
218 ;;; names.
|
|
|
219
|
|
|
220 ;;; FTP processes:
|
|
|
221 ;;;
|
|
|
222 ;;; When efs starts up an FTP process, it leaves it running for speed
|
|
|
223 ;;; purposes. Some FTP servers will close the connection after a period of
|
|
|
224 ;;; time, but efs should be able to quietly reconnect the next time that
|
|
|
225 ;;; the process is needed.
|
|
|
226 ;;;
|
|
|
227 ;;; The FTP process will be killed should the associated "*ftp user@host*"
|
|
|
228 ;;; buffer be deleted. This should not cause efs any grief.
|
|
|
229
|
|
|
230 ;;; Showing background FTP activity on the mode-line:
|
|
|
231 ;;;
|
|
|
232 ;;; After efs is loaded, the command efs-display-ftp-activity will cause
|
|
|
233 ;;; background FTP activity to be displayed on the mode line. The variable
|
|
|
234 ;;; efs-mode-line-format is used to determine how this data is displayed.
|
|
|
235 ;;; efs does not continuously track the number of active sessions, as this
|
|
|
236 ;;; would cause the display to change too rapidly. Rather, it uses a heuristic
|
|
|
237 ;;; algorithm to determine when there is a significant change in FTP activity.
|
|
|
238
|
|
|
239 ;;; File types:
|
|
|
240 ;;;
|
|
|
241 ;;; By default efs will assume that all files are ASCII. If a file
|
|
|
242 ;;; being transferred matches the value of efs-binary-file-name-regexp
|
|
|
243 ;;; then the file will be assumed to be a binary file, and efs will
|
|
|
244 ;;; transfer it using "type image". ASCII files will be transferred
|
|
|
245 ;;; using a transfer type which efs computes to be correct according
|
|
|
246 ;;; to its knowledge of the file system of the remote host. The
|
|
|
247 ;;; command `efs-prompt-for-transfer-type' toggles the variable
|
|
|
248 ;;; `efs-prompt-for-transfer-type'. When this variable is non-nil, efs
|
|
|
249 ;;; will prompt the user for the transfer type to use for every FTP
|
|
|
250 ;;; transfer. Having this set all the time is annoying, but it is
|
|
|
251 ;;; useful to give special treatment to a small set of files.
|
|
|
252 ;;; There is also variable efs-text-file-name-regexp. This is tested before
|
|
|
253 ;;; efs-binary-file-name-regexp, so if you set efs-text-file-name-regexp
|
|
|
254 ;;; to a non-trivial regular expression, and efs-binary-file-name-regexp
|
|
|
255 ;;; to ".*", the result will to make image the default tranfer type.
|
|
|
256 ;;;
|
|
|
257 ;;; Also, if you set efs-treat-crlf-as-nl, then efs will use type image
|
|
|
258 ;;; to transfer files between hosts whose file system differ only in that
|
|
|
259 ;;; one specifies end of line as CR-LF, and the other as NL. This is useful
|
|
|
260 ;;; if you are transferring files between UNIX and DOS machines, and have a
|
|
|
261 ;;; package such as dos-mode.el, that handles the extra ^M's.
|
|
|
262
|
|
|
263 ;;; Account passwords:
|
|
|
264 ;;;
|
|
|
265 ;;; Some FTP servers require an additional password which is sent by
|
|
|
266 ;;; the ACCOUNT command. efs will detect this and prompt the user for
|
|
|
267 ;;; an account password if the server expects one. Also, an account
|
|
|
268 ;;; password can be set by calling efs-set-account, or by specifying
|
|
|
269 ;;; an account token in the .netrc file.
|
|
|
270 ;;;
|
|
|
271 ;;; Some operating systems, such as CMS, require that ACCOUNT be used to
|
|
|
272 ;;; give a write access password for minidisks. efs-set-account can be used
|
|
|
273 ;;; to set a write password for a specific minidisk. Also, tokens of the form
|
|
|
274 ;;; minidisk <minidisk name> <password>
|
|
|
275 ;;; may be added to host lines in your .netrc file. Minidisk tokens must be
|
|
|
276 ;;; at the end of the host line, however there may be an arbitrary number of
|
|
|
277 ;;; them for any given host.
|
|
|
278
|
|
|
279 ;;; Preloading:
|
|
|
280 ;;;
|
|
|
281 ;;; efs can be preloaded, but must be put in the site-init.el file and
|
|
|
282 ;;; not the site-load.el file in order for the documentation strings for the
|
|
|
283 ;;; functions being overloaded to be available.
|
|
|
284
|
|
|
285 ;;; Status reports:
|
|
|
286 ;;;
|
|
|
287 ;;; Most efs commands that talk to the FTP process output a status
|
|
|
288 ;;; message on what they are doing. In addition, efs can take advantage
|
|
|
289 ;;; of the FTP client's HASH command to display the status of transferring
|
|
|
290 ;;; files and listing directories. See the documentation for the variables
|
|
|
291 ;;; efs-hash-mark-size, efs-send-hash and efs-verbose for more details.
|
|
|
292
|
|
|
293 ;;; Caching of directory information:
|
|
|
294 ;;;
|
|
|
295 ;;; efs keeps an internal cache of file listings from remote hosts.
|
|
|
296 ;;; If this cache gets out of synch, it can be renewed by reverting a
|
|
|
297 ;;; dired buffer for the appropriate directory (dired-revert is usually
|
|
|
298 ;;; bound to "g").
|
|
|
299 ;;;
|
|
|
300 ;;; Alternatively, you can add the following two lines to your .emacs file
|
|
|
301 ;;; if you want C-r to refresh efs's cache whilst doing filename
|
|
|
302 ;;; completion.
|
|
|
303 ;;; (define-key minibuffer-local-completion-map "\C-r" 'efs-re-read-dir)
|
|
|
304 ;;; (define-key minibuffer-local-must-match-map "\C-r" 'efs-re-read-dir)
|
|
|
305
|
|
|
306 ;;; Gateways:
|
|
|
307 ;;;
|
|
40
|
308 ;;; Sometimes it is necessary for the FTP process to be run on a different
|
|
22
|
309 ;;; machine than the machine running GNU Emacs. This can happen when the
|
|
|
310 ;;; local machine has restrictions on what hosts it can access.
|
|
|
311 ;;;
|
|
|
312 ;;; efs has support for running the ftp process on a different (gateway)
|
|
|
313 ;;; machine. The way it works is as follows:
|
|
|
314 ;;;
|
|
|
315 ;;; 1) Set the variable 'efs-gateway-host' to the name of a machine
|
|
|
316 ;;; that doesn't have the access restrictions. If you need to use
|
|
|
317 ;;; a nonstandard port to access this host for gateway use, then
|
|
|
318 ;;; specify efs-gateway-host as "<hostname>#<port>".
|
|
|
319 ;;;
|
|
|
320 ;;; 2) Set the variable 'efs-ftp-local-host-regexp' to a regular expression
|
|
|
321 ;;; that matches hosts that can be contacted from running a local ftp
|
|
|
322 ;;; process, but fails to match hosts that can't be accessed locally. For
|
|
|
323 ;;; example:
|
|
|
324 ;;;
|
|
|
325 ;;; "\\.hp\\.com$\\|^[^.]*$"
|
|
|
326 ;;;
|
|
|
327 ;;; will match all hosts that are in the .hp.com domain, or don't have an
|
|
|
328 ;;; explicit domain in their name, but will fail to match hosts with
|
|
|
329 ;;; explicit domains or that are specified by their ip address.
|
|
|
330 ;;;
|
|
|
331 ;;; 3) Set the variable `efs-local-host-regexp' to machines that you have
|
|
|
332 ;;; direct TCP/IP access. In other words, you must be able to ping these
|
|
|
333 ;;; hosts. Usually, efs-ftp-local-host-regexp and efs-local-host-regexp
|
|
|
334 ;;; will be the same. However, they will differ for so-called transparent
|
|
|
335 ;;; gateways. See #7 below for more details.
|
|
|
336 ;;;
|
|
|
337 ;;; 4) Set the variable 'efs-gateway-tmp-name-template' to the name of
|
|
|
338 ;;; a directory plus an identifying filename prefix for making temporary
|
|
|
339 ;;; files on the gateway. For example: "/tmp/hplose/ange/efs"
|
|
|
340 ;;;
|
|
|
341 ;;; 5) If the gateway and the local host share cross-mounted directories,
|
|
|
342 ;;; set the value of `efs-gateway-mounted-dirs-alist' accordingly. It
|
|
|
343 ;;; is particularly useful, but not mandatory, that the directory
|
|
|
344 ;;; of `efs-gateway-tmp-name-template' be cross-mounted.
|
|
|
345 ;;;
|
|
|
346 ;;; 6) Set the variable `efs-gateway-type' to the type gateway that you have.
|
|
|
347 ;;; This variable is a list, the first element of which is a symbol
|
|
|
348 ;;; denoting the type of gateway. Following elements give further
|
|
|
349 ;;; data on the gateway.
|
|
|
350 ;;;
|
|
|
351 ;;; Supported gateway types:
|
|
|
352 ;;;
|
|
|
353 ;;; a) local:
|
|
|
354 ;;; This means that your local host is itself the gateway. However,
|
|
|
355 ;;; it is necessary to use a different FTP client to gain access to
|
|
|
356 ;;; the outside world. If the name of the FTP client were xftp, you might
|
|
|
357 ;;; set efs-gateway-type to
|
|
|
358 ;;;
|
|
|
359 ;;; (list 'local "xftp" efs-ftp-program-args)
|
|
|
360 ;;;
|
|
|
361 ;;; If xftp required special arguments, then give them in place of
|
|
|
362 ;;; efs-ftp-program-args. See the documentation for efs-ftp-program-args
|
|
|
363 ;;; for the syntax.
|
|
|
364 ;;;
|
|
|
365 ;;; b) proxy:
|
|
|
366 ;;; This indicates that your gateway works by first FTP'ing to it, and
|
|
|
367 ;;; then issuing a USER command of the form
|
|
|
368 ;;;
|
|
|
369 ;;; USER <username>@<host>
|
|
|
370 ;;;
|
|
|
371 ;;; In this case, you might set efs-gateway-type to
|
|
|
372 ;;;
|
|
|
373 ;;; (list 'proxy "ftp" efs-ftp-program-args)
|
|
|
374 ;;;
|
|
|
375 ;;; If you need to use a nonstandard client, such as iftp, give this
|
|
|
376 ;;; instead of "ftp". If this client needs to take special arguments,
|
|
|
377 ;;; give them instead of efs-ftp-program-args.
|
|
|
378 ;;;
|
|
|
379 ;;; c) remsh:
|
|
|
380 ;;; For this type of gateway, you need to start a remote shell on
|
|
|
381 ;;; your gateway, using either remsh or rsh. You should set
|
|
|
382 ;;; efs-gateway-type to something like
|
|
|
383 ;;;
|
|
|
384 ;;; (list 'remsh "remsh" nil "ftp" efs-ftp-program-args)
|
|
|
385 ;;;
|
|
|
386 ;;; If you use rsh instead of remsh, change the second element from
|
|
|
387 ;;; "remsh" to "rsh". Note that the symbol indicating the gateway
|
|
|
388 ;;; type should still be 'remsh. If you want to pass arguments
|
|
|
389 ;;; to the remsh program, give them as the third element. For example,
|
|
|
390 ;;; if you need to specify a user, make this (list "-l" "sandy").
|
|
|
391 ;;; If you need to use a nonstandard FTP client, specify that as the fourth
|
|
|
392 ;;; element. If your FTP client needs to be given special arguments,
|
|
|
393 ;;; give them instead of efs-ftp-program-args.
|
|
|
394 ;;;
|
|
|
395 ;;; d) interactive:
|
|
|
396 ;;; This indicates that you need to establish a login on the gateway,
|
|
|
397 ;;; using either telnet or rlogin.
|
|
|
398 ;;; You should set efs-gateway-type to something like
|
|
|
399 ;;;
|
|
|
400 ;;; (list 'interactive "rlogin" nil "exec ftp" efs-ftp-program-args)
|
|
|
401 ;;;
|
|
|
402 ;;; If you need to use telnet, then give "telnet" in place of the second
|
|
|
403 ;;; element "rlogin". If your login program needs to be given arguments,
|
|
|
404 ;;; then they should be given in the third slot. The fourth element
|
|
|
405 ;;; is for the name of the FTP client program. Giving this as "exec ftp",
|
|
|
406 ;;; instead of "ftp", ensures that you are logged out if the FTP client
|
|
|
407 ;;; dies. If the FTP client takes special arguments, give these instead
|
|
|
408 ;;; of efs-ftp-program-args. Furthermore, you should see the documentation
|
|
|
409 ;;; at the top of efs-gwp.el. You may need to set the variables
|
|
|
410 ;;; efs-gwp-setup-term-command, and efs-gwp-prompt-pattern.
|
|
|
411 ;;;
|
|
|
412 ;;; e) raptor:
|
|
|
413 ;;; This is a type of gateway where efs is expected to specify a gateway
|
|
|
414 ;;; user, and send a password for this user using the ACCOUNT command.
|
|
|
415 ;;; For example, to log in to foobar.edu as sandy, while using the account
|
|
|
416 ;;; ange on the gateway, the following commands would be sent:
|
|
|
417 ;;;
|
|
|
418 ;;; open raptorgate.com
|
|
|
419 ;;; quote USER sandy@foobar.edu ange
|
|
|
420 ;;; quote pass <sandy's password on foobar>
|
|
|
421 ;;; quote account <ange's password on raptorgate>
|
|
|
422 ;;;
|
|
|
423 ;;; For such a gateway, you would set efs-gateway-type to
|
|
|
424 ;;;
|
|
|
425 ;;; (list 'raptor efs-ftp-program efs-ftp-program-args <GATEWAY USER>)
|
|
|
426 ;;;
|
|
|
427 ;;; where <GATEWAY USER> is the name of your account on the gateway. In
|
|
|
428 ;;; the above example, this would be "ange". You can set your gateway
|
|
|
429 ;;; password by simply setting an account password for the gateway host.
|
|
|
430 ;;; This can be done with either efs-set-account, or within your .netrc
|
|
|
431 ;;; file. If no password is set, you will be prompted for one.
|
|
|
432 ;;;
|
|
|
433 ;;; f) interlock:
|
|
|
434 ;;; This is a type of gateway where you are expected to send a PASS
|
|
|
435 ;;; command after opening the connection to the gateway.
|
|
|
436 ;;; The precise login sequence is
|
|
|
437 ;;;
|
|
|
438 ;;; open interlockgate
|
|
|
439 ;;; quote PASS <sandy's password on interlockgate>
|
|
|
440 ;;; quote USER sandy@foobar.edu
|
|
|
441 ;;; quote PASS <sandy's password on foobar.edu>
|
|
|
442 ;;;
|
|
|
443 ;;; For such a gateway, you should set efs-gateway-type to
|
|
|
444 ;;;
|
|
|
445 ;;; (list 'interlock efs-ftp-program efs-ftp-program-args)
|
|
|
446 ;;;
|
|
|
447 ;;; If you need to use a nonstandard name for your FTP client,
|
|
|
448 ;;; then replace efs-ftp-program with this name. If your FTP client
|
|
|
449 ;;; needs to take nonstandard arguments, then replace efs-ftp-program-args
|
|
|
450 ;;; with these arguments. See efs-ftp-program-args <V> for the required
|
|
|
451 ;;; syntax.
|
|
|
452 ;;;
|
|
|
453 ;;; If your gateway returns both a 220 code and a 331 code to the
|
|
|
454 ;;; "open interlockgate" command, then you should add a regular
|
|
|
455 ;;; expression to efs-skip-msgs <V> that matches the 220 response.
|
|
|
456 ;;; Returning two response codes to a single FTP command is not permitted
|
|
|
457 ;;; in RFC 959. It is not possible for efs to ignore the 220 by default,
|
|
|
458 ;;; because than it would hang for interlock installations which do not
|
|
|
459 ;;; require a password.
|
|
|
460 ;;;
|
|
|
461 ;;; g) kerberos:
|
|
|
462 ;;; With this gateway, you need to authenticate yourself by getting a
|
|
|
463 ;;; kerberos "ticket" first. Usually, this is done with the kinit program.
|
|
|
464 ;;; Once authenticated, you connect to foobar.com as user sandy with the
|
|
|
465 ;;; sequence: (Note that the "-n" argument inhibits automatic login.
|
|
|
466 ;;; Although, in manual use you probably don't use it, efs always uses it.)
|
|
|
467 ;;;
|
|
|
468 ;;; iftp -n
|
|
|
469 ;;; open foobar.com
|
|
|
470 ;;; user sandy@foobar.com
|
|
|
471 ;;;
|
|
|
472 ;;; You should set efs-gateway-type to something like
|
|
|
473 ;;;
|
|
|
474 ;;; (list 'kerberos "iftp" efs-ftp-program-args "kinit" <KINIT-ARGS>)
|
|
|
475 ;;;
|
|
|
476 ;;; If you use an FTP client other than iftp, insert its name instead
|
|
|
477 ;;; of "iftp" above. If your FTP client needs special arguments, give
|
|
|
478 ;;; them as a list of strings in place of efs-ftp-program-args. If
|
|
|
479 ;;; the program that you use to collect a ticket in not called "kinit",
|
|
|
480 ;;; then give its name in place of "kinit" above. <KINIT-ARGS> should be
|
|
|
481 ;;; any arguments that you need to pass to your kinit program, given as a
|
|
|
482 ;;; list of strings. Most likely, you will give this as nil.
|
|
|
483 ;;;
|
|
|
484 ;;; See the file efs-kerberos.el for more configuration variables. If you
|
|
|
485 ;;; need to adjust any of these variables, please report this to us so that
|
|
|
486 ;;; we can fix them for other users.
|
|
|
487 ;;;
|
|
|
488 ;;; If efs detects that you are not authenticated to use the gateway, it
|
|
|
489 ;;; will run the kinit program automatically, prompting you for a password.
|
|
|
490 ;;; If you give a password in your .netrc file for login the value of
|
|
|
491 ;;; efs-gateway-host <V> and user kerberos, then efs will use this to
|
|
|
492 ;;; obtain gateway authentication.
|
|
|
493 ;;;
|
|
|
494 ;;; 7) Transparent gateways:
|
|
|
495 ;;;
|
|
|
496 ;;; If your gateway is completely transparent (for example it uses
|
|
|
497 ;;; socks), then you should set efs-gateway-type to nil. Also,
|
|
|
498 ;;; set efs-ftp-local-host-regexp to ".*". However, efs-local-host-regexp,
|
|
|
499 ;;; must still be set to a regular expression matching hosts in your local
|
|
|
500 ;;; domain. efs uses this to determine which machines that it can
|
|
|
501 ;;; open-network-stream to. Furthermore, you should still set
|
|
|
502 ;;; efs-gateway-host to the name of your gateway machine. That way efs
|
|
|
503 ;;; will know that this is a special machine having direct TCP/IP access
|
|
|
504 ;;; to both hosts in the outside world, and hosts in your local domain.
|
|
|
505 ;;;
|
|
|
506 ;;; 8) Common Problems with Gateways:
|
|
|
507 ;;;
|
|
|
508 ;;; a) Spurious 220 responses:
|
|
|
509 ;;; Some proxy-style gateways (eg gateway type 'proxy or 'raptor),
|
|
|
510 ;;; return two 3-digit FTP reply codes to the USER command.
|
|
|
511 ;;; For example:
|
|
|
512 ;;;
|
|
|
513 ;;; open gateway.weird
|
|
|
514 ;;; 220 Connected to gateway.weird
|
|
|
515 ;;; quote USER sandy@foobar
|
|
|
516 ;;; 220 Connected to foobar
|
|
|
517 ;;; 331 Password required for sandy
|
|
|
518 ;;;
|
|
|
519 ;;; This is wrong, according to the FT Protocol. Each command must return
|
|
|
520 ;;; exactly one 3-digit reply code. It may be preceded by continuation
|
|
|
521 ;;; lines. What should really be returned is:
|
|
|
522 ;;;
|
|
|
523 ;;; quote USER sandy@foobar
|
|
|
524 ;;; 331-Connected to foobar.
|
|
|
525 ;;; 331 Password required for sandy.
|
|
|
526 ;;;
|
|
|
527 ;;; or even
|
|
|
528 ;;;
|
|
|
529 ;;; quote USER sandy@foobar
|
|
|
530 ;;; 331-220 Connected to foobar.
|
|
|
531 ;;; 331 Password required for sandy.
|
|
|
532 ;;;
|
|
|
533 ;;; Even though the "331-220" looks strange, it is correct protocol, and
|
|
|
534 ;;; efs will parse it properly.
|
|
|
535 ;;;
|
|
|
536 ;;; If your gateway is returning a spurious 220 to USER, a work-around
|
|
|
537 ;;; is to add a regular expression to `efs-skip-msgs' that matches
|
|
|
538 ;;; this line. It must not match the 220 line returned to the open
|
|
|
539 ;;; command. This work-around may not work, as some system FTP clients
|
|
|
540 ;;; also get confused by the spurious 220. In this case, the only
|
|
|
541 ;;; solution is to patch the gateway server. In either case, please
|
|
|
542 ;;; send a bug report to the author of your gateway software.
|
|
|
543 ;;;
|
|
|
544 ;;; b) Case-sensitive parsing of FTP commands:
|
|
|
545 ;;; Some gateway servers seem to treat FTP commands case-sensitively.
|
|
|
546 ;;; This is incorrect, as RFC 959 clearly states that FTP commands
|
|
|
547 ;;; are always to be case-insensitive. If this is a problem with your
|
|
|
548 ;;; gateway server, you should send a bug report to its author.
|
|
|
549 ;;; If efs is using a case for FTP commands that does not suit your server,
|
|
|
550 ;;; a possible work-around is to edit the efs source so that the required
|
|
|
551 ;;; case is used. However, we will not be making any changes to the
|
|
|
552 ;;; standard efs distribution to support this type of server behaviour.
|
|
|
553 ;;; If you need help changing the efs source, you should enquire with the
|
|
|
554 ;;; efs-help mailing list.
|
|
|
555 ;;;
|
|
|
556
|
|
|
557 ;;; ---------------------------------------------------------------
|
|
|
558 ;;; Tips for using efs:
|
|
|
559 ;;; ---------------------------------------------------------------
|
|
|
560
|
|
|
561 ;;; 1) Beware of compressing files on non-UNIX hosts. efs will do it by
|
|
|
562 ;;; copying the file to the local machine, compressing it there, and then
|
|
|
563 ;;; sending it back. Binary file transfers between machines of different
|
|
|
564 ;;; architectures can be a risky business. Test things out first on some
|
|
|
565 ;;; test files. See "Bugs" below. Also, note that efs sometimes
|
|
|
566 ;;; copies files by moving them through the local machine. Again,
|
|
|
567 ;;; be careful when doing this with binary files on non-Unix
|
|
|
568 ;;; machines.
|
|
|
569 ;;;
|
|
|
570 ;;; 2) Beware that dired over ftp will use your setting of dired-no-confirm
|
|
|
571 ;;; (list of dired commands for which confirmation is not asked).
|
|
|
572 ;;; You might want to reconsider your setting of this variable,
|
|
|
573 ;;; because you might want confirmation for more commands on remote
|
|
|
574 ;;; direds than on local direds. For example, I strongly recommend
|
|
|
575 ;;; that you not include compress in this list. If there is enough
|
|
|
576 ;;; demand it might be a good idea to have an alist
|
|
|
577 ;;; efs-dired-no-confirm of pairs ( TYPE . LIST ), where TYPE is an
|
|
|
578 ;;; operating system type and LIST is a list of commands for which
|
|
|
579 ;;; confirmation would be suppressed. Then remote dired listings
|
|
|
580 ;;; would take their (buffer-local) value of dired-no-confirm from
|
|
|
581 ;;; this alist. Who votes for this?
|
|
|
582 ;;;
|
|
|
583 ;;; 3) Some combinations of FTP clients and servers break and get out of sync
|
|
|
584 ;;; when asked to list a non-existent directory. Some of the ai.mit.edu
|
|
|
585 ;;; machines cause this problem for some FTP clients. Using
|
|
|
586 ;;; efs-kill-ftp-process can be used to restart the ftp process, which
|
|
|
587 ;;; should get things back in synch.
|
|
|
588 ;;;
|
|
|
589 ;;; 4) Some ftp servers impose a length limit on the password that can
|
|
|
590 ;;; be sent. If this limit is exceeded they may bomb in an
|
|
|
591 ;;; incomprehensible way. This sort of behaviour is common with
|
|
|
592 ;;; MVS servers. Therefore, you should beware of this possibility
|
|
|
593 ;;; if you are generating a long password (like an email address)
|
|
|
594 ;;; with efs-generate-anonymous-password.
|
|
|
595 ;;;
|
|
|
596 ;;; 5) Some antiquated FTP servers hang when asked for an RNFR command.
|
|
|
597 ;;; efs sometimes uses this to test whether its local cache is stale.
|
|
|
598 ;;; If your server for HOST hangs when asked for this command, put
|
|
|
599 ;;; (efs-set-host-property HOST 'rnfr-failed t)
|
|
|
600 ;;; in your efs-ftp-startup-function-alist entry for HOST.
|
|
|
601 ;;;
|
|
|
602
|
|
|
603 ;;; -----------------------------------------------------------------------
|
|
|
604 ;;; Where to get the latest version of efs:
|
|
|
605 ;;; -----------------------------------------------------------------------
|
|
|
606 ;;;
|
|
|
607 ;;; The authors are grateful to anyone or any organization which
|
|
|
608 ;;; provides anonymous FTP distribution for efs.
|
|
|
609 ;;;
|
|
|
610 ;;;
|
|
|
611 ;;; Europe:
|
|
|
612 ;;;
|
|
|
613 ;;; Switzerland
|
|
|
614 ;;; /anonymous@itp.ethz.ch:/sandy/efs/
|
|
|
615 ;;;
|
|
|
616 ;;; North America:
|
|
|
617 ;;;
|
|
|
618 ;;; Massachusetts, USA
|
|
|
619 ;;; /anonymous@alpha.gnu.ai.mit.edu:/efs/
|
|
|
620 ;;;
|
|
|
621 ;;; California, USA
|
|
|
622 ;;; /anonymous@ftp.hmc.edu:/pub/emacs/packages/efs/
|
|
|
623 ;;;
|
|
|
624 ;;; Australia and New Zealand:
|
|
|
625 ;;;
|
|
|
626 ;;; ????????????
|
|
|
627 ;;;
|
|
|
628 ;;; Japan:
|
|
|
629 ;;;
|
|
|
630 ;;; ????????????
|
|
|
631
|
|
|
632 ;;; ---------------------------------------------------------------------
|
|
|
633 ;;; Non-UNIX support:
|
|
|
634 ;;; ---------------------------------------------------------------------
|
|
|
635
|
|
|
636 ;;; efs has full support, incuding file name completion and tree dired
|
|
|
637 ;;; for:
|
|
|
638 ;;;
|
|
|
639 ;;; VMS, CMS, MTS, MVS, ti-twenex, ti-explorer (the last two are lisp
|
|
|
640 ;;; machines), TOPS-20, DOS (running the Distinct, Novell, FTP
|
|
|
641 ;;; software, NCSA, Microsoft in both unix and DOS mode, Super TCP, and
|
|
|
642 ;;; Hellsoft FTP servers), unix descriptive listings (dl), KA9Q, OS/2,
|
|
|
643 ;;; VOS, NOS/VE, CMS running the KNET server, Tandem's Guardian OS, COKE
|
|
|
644 ;;;
|
|
|
645 ;;; efs should be able to automatically recognize any of the operating
|
|
|
646 ;;; systems and FTP servers that it supports. Please report any
|
|
|
647 ;;; failure to do so to the "bugs" address below. You can specify a
|
|
|
648 ;;; certain host as being of a given host type with the command
|
|
|
649 ;;;
|
|
|
650 ;;; (efs-add-host <host-type> <host>)
|
|
|
651 ;;;
|
|
|
652 ;;; <host-type> is a symbol, <host> is a string. If this command is
|
|
|
653 ;;; used interactively, then <host-type> is prompted for with
|
|
|
654 ;;; completion. Some host types have regexps that can be used to
|
|
|
655 ;;; specify a class of host names as being of a certain type. Note
|
|
|
656 ;;; that if you specify a host as being of a certain type, efs does
|
|
|
657 ;;; not verify that that is really the type of the host. This calls
|
|
|
658 ;;; for caution when using regexps to specify host types, as an
|
|
|
659 ;;; inadvertent match to a regexp might have unpleasant consequences.
|
|
|
660 ;;;
|
|
|
661 ;;; See the respective efs-TYPE.el files for more information.
|
|
|
662 ;;; When or if we get a tex info file, it should contain some more
|
|
|
663 ;;; details on the non-unix support.
|
|
|
664
|
|
|
665 ;;; ------------------------------------------------------------------
|
|
|
666 ;;; Bugs and other things that go clunk in the night:
|
|
|
667 ;;; ------------------------------------------------------------------
|
|
|
668
|
|
|
669 ;;; How to report a bug:
|
|
|
670 ;;; --------------------
|
|
|
671 ;;;
|
|
|
672 ;;; Type M-x efs-report-bug
|
|
|
673 ;;; or
|
|
|
674 ;;; send mail to efs-bugs@cuckoo.hpl.hp.com.
|
|
|
675 ;;;
|
|
|
676 ;;; efs is a "free" program. This means that you didn't (or shouldn't
|
|
|
677 ;;; have) paid anything for it. It also means that nobody is paid to
|
|
|
678 ;;; maintain it, and the authors weren't paid for writing it.
|
|
|
679 ;;; Therefore, please try to write your bug report in a clear and
|
|
|
680 ;;; complete fashion. It will greatly enhance the probability that
|
|
|
681 ;;; something will be done about your problem.
|
|
|
682 ;;;
|
|
|
683 ;;; Note that efs relies heavily in cached information, so the bug may
|
|
|
684 ;;; depend in a complicated fashion on commands that were performed on
|
|
|
685 ;;; remote files from the beginning of your emacs session. Trying to
|
|
|
686 ;;; reproduce your bug starting from a fresh emacs session is usually
|
|
|
687 ;;; a good idea.
|
|
|
688 ;;;
|
|
|
689
|
|
|
690 ;;; Fan/hate mail:
|
|
|
691 ;;; --------------
|
|
|
692 ;;;
|
|
|
693 ;;; efs has its own mailing list called efs-help. All users of efs
|
|
|
694 ;;; are welcome to subscribe (see below) and to discuss aspects of
|
|
|
695 ;;; efs. New versions of efs are posted periodically to the mailing
|
|
|
696 ;;; list.
|
|
|
697 ;;;
|
|
|
698 ;;; To [un]subscribe to efs-help, or to report mailer problems with the
|
|
|
699 ;;; list, please mail one of the following addresses:
|
|
|
700 ;;;
|
|
|
701 ;;; efs-help-request@cuckoo.hpl.hp.com
|
|
|
702 ;;; or
|
|
|
703 ;;; efs-help-request%cuckoo.hpl.hp.com@hplb.hpl.hp.com
|
|
|
704 ;;;
|
|
|
705 ;;; Please don't forget the -request part.
|
|
|
706 ;;;
|
|
|
707 ;;; For mail to be posted directly to efs-help, send to one of the
|
|
|
708 ;;; following addresses:
|
|
|
709 ;;;
|
|
|
710 ;;; efs-help@cuckoo.hpl.hp.com
|
|
|
711 ;;; or
|
|
|
712 ;;; efs-help%cuckoo.hpl.hp.com@hplb.hpl.hp.com
|
|
|
713 ;;;
|
|
|
714 ;;; Alternatively, there is a mailing list that only gets
|
|
|
715 ;;; announcements of new efs releases. This is called efs-announce,
|
|
|
716 ;;; and can be subscribed to by e-mailing to the -request address as
|
|
|
717 ;;; above. Please make it clear in the request which mailing list you
|
|
|
718 ;;; wish to join.
|
|
|
719 ;;;
|
|
|
720
|
|
|
721 ;;; Known bugs:
|
|
|
722 ;;; -----------
|
|
|
723 ;;;
|
|
|
724 ;;; If you hit a bug in this list, please report it anyway. Most of
|
|
|
725 ;;; the bugs here remain unfixed because they are considered too
|
|
|
726 ;;; esoteric to be a high priority. If one of them gets reported
|
|
|
727 ;;; enough, we will likely change our view on that.
|
|
|
728 ;;;
|
|
|
729 ;;; 1) efs does not check to make sure that when creating a new file,
|
|
|
730 ;;; you provide a valid filename for the remote operating system.
|
|
|
731 ;;; If you do not, then the remote FTP server will most likely
|
|
|
732 ;;; translate your filename in some way. This may cause efs to
|
|
|
733 ;;; get confused about what exactly is the name of the file.
|
|
|
734 ;;;
|
|
|
735 ;;; 2) For CMS support, we send too many cd's. Since cd's are cheap, I haven't
|
|
|
736 ;;; worried about this too much. Eventually, we should have some caching
|
|
|
737 ;;; of the current minidisk. This is complicated by the fact that some
|
|
|
738 ;;; CMS servers lie about the current minidisk, so sending redundant
|
|
|
739 ;;; cd's helps us recover in this case.
|
|
|
740 ;;;
|
|
|
741 ;;; 3) The code to do compression of files over ftp is not as careful as it
|
|
|
742 ;;; should be. It deletes the old remote version of the file, before
|
|
|
743 ;;; actually checking if the local to remote transfer of the compressed
|
|
|
744 ;;; file succeeds. Of course to delete the original version of the file
|
|
|
745 ;;; after transferring the compressed version back is also dangerous,
|
|
|
746 ;;; because some OS's have severe restrictions on the length of filenames,
|
|
|
747 ;;; and when the compressed version is copied back the "-Z" or ".Z" may be
|
|
|
748 ;;; truncated. Then, efs would delete the only remaining version of
|
|
|
749 ;;; the file. Maybe efs should make backups when it compresses files
|
|
|
750 ;;; (of course, the backup "~" could also be truncated off, sigh...).
|
|
|
751 ;;; Suggestions?
|
|
|
752 ;;;
|
|
|
753 ;;; 4) If a dir listing is attempted for an empty directory on (at least
|
|
|
754 ;;; some) VMS hosts, an ftp error is given. This is really an ftp bug, and
|
|
|
755 ;;; I don't know how to get efs work to around it.
|
|
|
756 ;;;
|
|
|
757 ;;; 5) efs gets confused by directories containing file names with
|
|
|
758 ;;; embedded newlines. A temporary solution is to add "q" to your
|
|
|
759 ;;; dired listing switches. As long as your dired listing switches
|
|
|
760 ;;; also contain "l" and either "a" or "A", efs will use these
|
|
|
761 ;;; switches to get listings for its internal cache. The "q" switch
|
|
|
762 ;;; should force listings to be exactly one file per line. You
|
|
|
763 ;;; still will not be able to access a file with embedded newlines,
|
|
|
764 ;;; but at least it won't mess up the parsing of the rest of the files.
|
|
|
765 ;;;
|
|
|
766 ;;; 6) efs cannot parse symlinks which have an embedded " -> "
|
|
|
767 ;;; in their name. It's alright to have an embedded " -> " in the name
|
|
|
768 ;;; of any other type of file. A fix is possible, but probably not worth
|
|
|
769 ;;; the trouble. If you disagree, send us a bug report.
|
|
|
770 ;;;
|
|
|
771 ;;; 7) efs doesn't handle context-dep. files in H-switch listings on
|
|
|
772 ;;; HP's. It wouldn't be such a big roaring deal to fix this. I'm
|
|
|
773 ;;; waiting until I get an actual bug report though.
|
|
|
774 ;;;
|
|
|
775 ;;; 8) If a hard link is added or deleted, efs will not update its
|
|
|
776 ;;; internal cache of the link count for other names of the file.
|
|
|
777 ;;; This may cause file-nlinks to return incorrectly. Reverting
|
|
|
778 ;;; any dired buffer containing other names for the file will
|
|
|
779 ;;; cause the file data to be updated, including the link counts.
|
|
|
780 ;;; A fix for this problem is known and will be eventually
|
|
|
781 ;;; implemented. How it is implemented will depend on how we decide
|
|
|
782 ;;; to handle inodes. See below.
|
|
|
783 ;;;
|
|
|
784 ;;; 9) efs is unable to parse R-switch listings from remote unix hosts.
|
|
|
785 ;;; This is inefficient, because efs will insist on doing individual
|
|
|
786 ;;; listings of the subdirectories to get its file information.
|
|
|
787 ;;; This may be fixed if there is enough demand.
|
|
|
788 ;;;
|
|
|
789 ;;; 10) In file-attributes, efs returns a fake inode number. Of course
|
|
|
790 ;;; this is necessary, but this inode number is not even necessarily
|
|
|
791 ;;; unique. It is simply the sum of the characters (treated as
|
|
|
792 ;;; integers) in the host name, user name, and file name. Possible
|
|
|
793 ;;; ways to get a unique inode number are:
|
|
|
794 ;;; a) Simply keep a count of all remote file in the cache, and
|
|
|
795 ;;; return the file's position in this count as a negative number.
|
|
|
796 ;;; b) For unix systems, we could actually get at the real inode
|
|
|
797 ;;; number on the remote host, by adding an "i" to the ls switches.
|
|
|
798 ;;; The inode numbers would then be removed from the listing
|
|
|
799 ;;; returned by efs-ls, if the caller hadn't requested the "i"
|
|
|
800 ;;; switch. We could then make a unique number out of the host name
|
|
|
801 ;;; and the real inode number.
|
|
|
802 ;;;
|
|
|
803 ;;; 11) efs tries to determine if a file is readable or writable by comparing
|
|
|
804 ;;; the file modes, file owner, and user name under which it is logged
|
|
|
805 ;;; into the remote host. This does not take into account groups.
|
|
|
806 ;;; We simply assume that the user belongs to all groups. As a result
|
|
|
807 ;;; we may assume that a file is writable, when in fact it is not.
|
|
|
808 ;;; Groups are tough to handle correctly over FTP. Suggestions?
|
|
|
809 ;;; (For new FTP servers, can do a "QUOTE SITE EXEC groups" to
|
|
|
810 ;;; handle this.)
|
|
|
811
|
|
|
812 ;;; -----------------------------------------------------------
|
|
|
813 ;;; Technical information on this package:
|
|
|
814 ;;; -----------------------------------------------------------
|
|
|
815
|
|
|
816 ;;; efs hooks onto the following functions using the
|
|
|
817 ;;; file-name-handler-alist. Depending on which version of emacs you
|
|
|
818 ;;; are using, not all of these functions may access this alist. In
|
|
|
819 ;;; this case, efs overloads the definitions of these functions with
|
|
|
820 ;;; versions that do access the file-name-handler-alist. These
|
|
|
821 ;;; overloads are done in efs's version-specific files.
|
|
|
822 ;;;
|
|
|
823 ;;; abbreviate-file-name
|
|
|
824 ;;; backup-buffer
|
|
|
825 ;;; copy-file
|
|
|
826 ;;; create-file-buffer
|
|
|
827 ;;; delete-directory
|
|
|
828 ;;; delete-file
|
|
|
829 ;;; directory-file-name
|
|
|
830 ;;; directory-files
|
|
|
831 ;;; file-attributes
|
|
|
832 ;;; file-directory-p
|
|
|
833 ;;; file-exists-p
|
|
|
834 ;;; file-local-copy
|
|
|
835 ;;; file-modes
|
|
|
836 ;;; file-name-all-completions
|
|
|
837 ;;; file-name-as-directory
|
|
|
838 ;;; file-name-completion
|
|
|
839 ;;; file-name-directory
|
|
|
840 ;;; file-name-nondirectory
|
|
|
841 ;;; file-name-sans-versions
|
|
|
842 ;;; file-newer-than-file-p
|
|
|
843 ;;; file-readable-p
|
|
|
844 ;;; file-executable-p
|
|
|
845 ;;; file-accessible-directory-p
|
|
|
846 ;;; file-symlink-p
|
|
|
847 ;;; file-writable-p
|
|
|
848 ;;; get-file-buffer
|
|
|
849 ;;; insert-directory
|
|
|
850 ;;; insert-file-contents
|
|
|
851 ;;; list-directory
|
|
|
852 ;;; make-directory-internal
|
|
|
853 ;;; rename-file
|
|
|
854 ;;; set-file-modes
|
|
|
855 ;;; set-visited-file-modtime
|
|
|
856 ;;; substitute-in-file-name
|
|
|
857 ;;; verify-visited-file-modtime
|
|
|
858 ;;; write-region
|
|
|
859 ;;;
|
|
|
860 ;;; The following functions are overloaded in efs.el, because they cannot
|
|
|
861 ;;; be handled via the file-name-handler-alist.
|
|
|
862 ;;;
|
|
|
863 ;;; expand-file-name
|
|
|
864 ;;; load
|
|
|
865 ;;; read-file-name-internal (Emacs 18, only)
|
|
|
866 ;;; require
|
|
|
867 ;;;
|
|
|
868 ;;; The following dired functions are handled by hooking them into the
|
|
|
869 ;;; the file-name-handler-alist. This is done in efs-dired.el.
|
|
|
870 ;;;
|
|
|
871 ;;; efs-dired-compress-file
|
|
|
872 ;;; eds-dired-print-file
|
|
|
873 ;;; efs-dired-make-compressed-filename
|
|
|
874 ;;; efs-compress-file
|
|
|
875 ;;; efs-dired-print-file
|
|
|
876 ;;; efs-dired-create-directory
|
|
|
877 ;;; efs-dired-recursive-delete-directory
|
|
|
878 ;;; efs-dired-uncache
|
|
|
879 ;;; efs-dired-call-process
|
|
|
880 ;;;
|
|
|
881 ;;; In efs-dired.el, the following dired finctions are overloaded.
|
|
|
882 ;;;
|
|
|
883 ;;; dired-collect-file-versions
|
|
|
884 ;;; dired-find-file
|
|
|
885 ;;; dired-flag-backup-files
|
|
|
886 ;;; dired-get-filename
|
|
|
887 ;;; dired-insert-headerline
|
|
|
888 ;;; dired-move-to-end-of-filename
|
|
|
889 ;;; dired-move-to-filename
|
|
|
890 ;;; dired-run-shell-command
|
|
|
891 ;;;
|
|
|
892 ;;; efs makes use of the following hooks
|
|
|
893 ;;;
|
|
|
894 ;;; diff-load-hook
|
|
|
895 ;;; dired-before-readin-hook
|
|
|
896 ;;; find-file-hooks
|
|
|
897 ;;; dired-grep-load-hook
|
|
|
898
|
|
|
899 ;;; LISPDIR ENTRY for the Elisp Archive:
|
|
|
900 ;;;
|
|
|
901 ;;; LCD Archive Entry:
|
|
|
902 ;;; efs|Andy Norman and Sandy Rutherford
|
|
|
903 ;;; |ange@hplb.hpl.hp.com and sandy@ibm550.sissa.it
|
|
|
904 ;;; |transparent FTP Support for GNU Emacs
|
|
24
|
905 ;;; |$Date: 94/08/25 $|$efs release: 1.15 beta $|
|
|
22
|
906
|
|
|
907 ;;; Host and listing type notation:
|
|
|
908 ;;;
|
|
|
909 ;;; The functions efs-host-type and efs-listing-type, and the
|
|
|
910 ;;; variable efs-dired-host-type follow the following conventions
|
|
|
911 ;;; for remote host types.
|
|
|
912 ;;;
|
|
|
913 ;;; nil = local host type, whatever that is (probably unix).
|
|
|
914 ;;; Think nil as in "not a remote host". This value is used by
|
|
|
915 ;;; efs-dired-host-type for local buffers.
|
|
|
916 ;;; (efs-host-type nil) => nil
|
|
|
917 ;;;
|
|
|
918 ;;; 'type = a remote host of TYPE type.
|
|
|
919 ;;;
|
|
|
920 ;;; 'type:list = a remote host using listing type 'type:list.
|
|
|
921 ;;; This is currently used for Unix dl (descriptive
|
|
|
922 ;;; listings), when efs-dired-host-type is set to
|
|
|
923 ;;; 'unix:dl, and to support the myriad of DOS FTP
|
|
|
924 ;;; servers.
|
|
|
925
|
|
|
926 ;;; Supported host and listing types:
|
|
|
927 ;;;
|
|
|
928 ;;; unknown, unix, dumb-unix, bsd-unix, sysV-unix, next-unix,
|
|
|
929 ;;; super-dumb-unix, dumb-apollo-unix,
|
|
|
930 ;;; apollo-unix, unix:dl, dos-distinct, ka9q, dos, dos:ftp, dos:novell,
|
|
|
931 ;;; dos:ncsa, dos:winsock, vos, hell, dos:microsoft, super-dumb-unix
|
|
|
932 ;;; vms, cms, mts, mvs, mvs:tcp mvs:nih tops-20, mpe, ti-twenex,
|
|
|
933 ;;; ti-explorer, os2, vos,
|
|
|
934 ;;; vms:full, guardian, ms-unix (This is the Microsoft NT Windows server
|
|
|
935 ;;; in unix mode.), plan9, unix:unknown, nos-ve (actually NOS/VE).
|
|
|
936
|
|
|
937 ;;; Host and listing type hierarchy:
|
|
|
938 ;;;
|
|
|
939 ;;; unknown: unix, dumb-unix, sysV-unix, bsd-unix, next-unix, apollo-unix,
|
|
|
940 ;;; ka9q, dos-distinct, unix:dl, hell,
|
|
|
941 ;;; super-dumb-unix, dumb-apollo-unix
|
|
|
942 ;;; unix: sysV-unix, bsd-unix, next-unix, apollo-unix, unix:dl
|
|
|
943 ;;; dos: dos:ftp, dos:novell, dos:ncsa, dos:microsoft, dos:winsock
|
|
|
944 ;;; dumb-unix:
|
|
|
945 ;;; bsd-unix:
|
|
|
946 ;;; sysV-unix:
|
|
|
947 ;;; next-unix:
|
|
|
948 ;;; apollo-unix:
|
|
|
949 ;;; dumb-apollo-unix:
|
|
|
950 ;;; unix:dl:
|
|
|
951 ;;; unix:unknown: unix:dl, unix
|
|
|
952 ;;; super-dumb-unix:
|
|
|
953 ;;; dos-distinct:
|
|
|
954 ;;; dos:ftp:
|
|
|
955 ;;; dos:novell:
|
|
|
956 ;;; dos:microsoft
|
|
|
957 ;;; ka9q:
|
|
|
958 ;;; vms: vms:full
|
|
|
959 ;;; cms:
|
|
|
960 ;;; mts:
|
|
|
961 ;;; mvs: mvs:tcp, mvs:nih
|
|
|
962 ;;; mvs:tcp:
|
|
|
963 ;;; mvs:nih:
|
|
|
964 ;;; tops-20:
|
|
|
965 ;;; ti-twenex:
|
|
|
966 ;;; ti-explorer:
|
|
|
967 ;;; os2:
|
|
|
968 ;;; vos:
|
|
|
969 ;;; vms:full:
|
|
|
970 ;;; dos:ncsa:
|
|
|
971 ;;; dos:winsock:
|
|
|
972 ;;; vos:
|
|
|
973 ;;; hell:
|
|
|
974 ;;; guardian:
|
|
|
975 ;;; ms-unix:
|
|
|
976 ;;; plan9:
|
|
|
977 ;;; nos-ve:
|
|
|
978 ;;; coke:
|
|
|
979 ;;;
|
|
|
980
|
|
|
981
|
|
|
982 ;;;; ================================================================
|
|
|
983 ;;;; >0
|
|
|
984 ;;;; Table of Contents for efs.el
|
|
|
985 ;;;; ================================================================
|
|
|
986 ;;
|
|
|
987 ;; Each section of efs.el is labelled by >#, where # is the number of
|
|
|
988 ;; the section.
|
|
|
989 ;;
|
|
|
990 ;; 1. Provisions, requirements, and autoloads.
|
|
|
991 ;; 2. Variable definitions.
|
|
|
992 ;; 3. Utilities.
|
|
|
993 ;; 4. Hosts, users, accounts, and passwords.
|
|
|
994 ;; 5. FTP client process and server responses.
|
|
|
995 ;; 6. Sending commands to the FTP server.
|
|
|
996 ;; 7. Parsing and storing remote file system data.
|
|
|
997 ;; 8. Redefinitions of standard GNU Emacs functions.
|
|
|
998 ;; 9. Multiple host type support.
|
|
|
999 ;; 10. Attaching onto the appropriate emacs version.
|
|
|
1000
|
|
|
1001
|
|
|
1002 ;;;; ================================================================
|
|
|
1003 ;;;; >1
|
|
|
1004 ;;;; General provisions, requirements, and autoloads.
|
|
|
1005 ;;;; Host type, and local emacs type dependent loads, and autoloads
|
|
|
1006 ;;;; are in the last two sections of this file.
|
|
|
1007 ;;;; ================================================================
|
|
|
1008
|
|
|
1009 ;;;; ----------------------------------------------------------------
|
|
|
1010 ;;;; Provide the package (Do this now to avoid an infinite loop)
|
|
|
1011 ;;;; ----------------------------------------------------------------
|
|
|
1012
|
|
|
1013 (provide 'efs)
|
|
|
1014
|
|
|
1015 ;;;; ----------------------------------------------------------------
|
|
|
1016 ;;;; Our requirements.
|
|
|
1017 ;;;; ----------------------------------------------------------------
|
|
|
1018
|
|
|
1019 (require 'backquote)
|
|
|
1020 (require 'comint)
|
|
|
1021 (require 'efs-defun)
|
|
|
1022 (require 'efs-netrc)
|
|
|
1023 (require 'efs-cu)
|
|
|
1024 (require 'efs-ovwrt)
|
|
|
1025 ;; Do this last, as it installs efs into the file-name-handler-alist.
|
|
|
1026 (require 'efs-fnh)
|
|
|
1027
|
|
|
1028 (autoload 'efs-report-bug "efs-report" "Submit a bug report for efs." t)
|
|
|
1029 (autoload 'efs-gwp-start "efs-gwp" ; For interactive gateways.
|
|
|
1030 "Login to the gateway machine and fire up an FTP client.")
|
|
|
1031 (autoload 'efs-kerberos-login "efs-kerberos")
|
|
|
1032 (autoload 'efs-insert-directory "efs-dired" "Insert a directory listing.")
|
|
|
1033 (autoload 'efs-set-mdtm-of "efs-cp-p")
|
|
|
1034 (autoload 'diff-latest-backup-file "diff")
|
|
|
1035 (autoload 'read-passwd "passwd" "Read a password from the minibuffer." t)
|
|
|
1036
|
|
|
1037
|
|
|
1038 ;;;; ============================================================
|
|
|
1039 ;;;; >2
|
|
|
1040 ;;;; Variable Definitions
|
|
|
1041 ;;;; **** The user configuration variables are in ****
|
|
|
1042 ;;;; **** the second subsection of this section. ****
|
|
|
1043 ;;;; ============================================================
|
|
|
1044
|
|
|
1045 ;;;; ------------------------------------------------------------
|
|
|
1046 ;;;; Constant Definitions
|
|
|
1047 ;;;; ------------------------------------------------------------
|
|
|
1048
|
|
|
1049 (defconst efs-version
|
|
|
1050 (concat (substring "$efs release: 1.15 $" 14 -2)
|
|
|
1051 "/"
|
|
42
|
1052 (substring "#Revision: 1.56 $" 11 -2)))
|
|
22
|
1053
|
|
|
1054 (defconst efs-time-zero 1970) ; we count time from midnight, Jan 1, 1970 GMT.
|
|
|
1055
|
|
|
1056 (defconst efs-dumb-host-types
|
|
|
1057 '(dumb-unix super-dumb-unix vms cms mts ti-twenex ti-explorer dos mvs
|
|
|
1058 tops-20 mpe ka9q dos-distinct os2 vos hell guardian
|
|
|
1059 netware cms-knet nos-ve coke dumb-apollo-unix)
|
|
|
1060 "List of host types that can't take UNIX ls-style listing options.")
|
|
|
1061 ;; dos-distinct only ignores ls switches; it doesn't barf.
|
|
|
1062 ;; Still treat it as dumb.
|
|
|
1063
|
|
|
1064 (defconst efs-unix-host-types
|
|
|
1065 '(unix sysV-unix bsd-unix next-unix apollo-unix dumb-unix
|
|
|
1066 dumb-apollo-unix super-dumb-unix)
|
|
|
1067 "List of unix host types.")
|
|
|
1068
|
|
|
1069 (defconst efs-version-host-types '(vms tops-20 ti-twenex ti-explorer)
|
|
|
1070 "List of host-types which associated a version number to all files.
|
|
|
1071 This is not the same as associating version numbers to only backup files.")
|
|
|
1072 ;; Note that on these systems,
|
|
|
1073 ;; (file-name-sans-versions EXISTING-FILE) does not exist as a file.
|
|
|
1074
|
|
|
1075 (defconst efs-single-extension-host-types
|
|
|
1076 '(vms tops-20 ti-twenex ti-explorer cms mvs dos ka9q dos-distinct hell
|
|
|
1077 netware ms-unix plan9 cms-knet nos-ve)
|
|
|
1078 "List of host types which allow at most one extension on a file name.
|
|
|
1079 Extensions are deliminated by \".\". In addition, these host-types must
|
|
|
1080 allow \"-\" in file names, because it will be used to add additional extensions
|
|
|
1081 to indicate compressed files.")
|
|
|
1082
|
|
|
1083 (defconst efs-idle-host-types
|
|
|
1084 (append '(coke unknown) efs-unix-host-types))
|
|
|
1085 ;; List of host types for which it is possible that the SITE IDLE command
|
|
|
1086 ;; is supported.
|
|
|
1087
|
|
|
1088 (defconst efs-listing-types
|
|
|
1089 '(unix:dl unix:unknown
|
|
|
1090 dos:novell dos:ftp dos:ncsa dos:microsoft dos:stcp dos:winsock
|
|
|
1091 mvs:nih mvs:tcp mvs:tcp
|
|
|
1092 vms:full)
|
|
|
1093 "List of supported listing types")
|
|
|
1094
|
|
|
1095 (defconst efs-nlist-listing-types
|
|
|
1096 '(vms:full))
|
|
|
1097 ;; Listing types which give a long useless listing when asked for a
|
|
|
1098 ;; LIST. For these, use an NLST instead. This can only be done
|
|
|
1099 ;; when there is some way to distinguish directories from
|
|
|
1100 ;; plain files in an NLST.
|
|
|
1101
|
|
|
1102 (defconst efs-opaque-gateways '(remsh interactive))
|
|
|
1103 ;; List of gateway types for which we need to do explicit file handling on
|
|
|
1104 ;; the gateway machine.
|
|
|
1105
|
|
|
1106 ;;;; ------------------------------------------------------------------
|
|
|
1107 ;;;; User customization variables. Please read through these carefully.
|
|
|
1108 ;;;; ------------------------------------------------------------------
|
|
|
1109
|
|
|
1110 ;;;>>>> If you are not fully connected to the internet, <<<<
|
|
|
1111 ;;;>>>> and need to use a gateway (no matter how transparent) <<<<
|
|
|
1112 ;;;>>>> you will need to set some of the following variables. <<<<
|
|
|
1113 ;;;>>>> Read the documentation carefully. <<<<
|
|
|
1114
|
|
|
1115 (defvar efs-local-host-regexp ".*"
|
|
|
1116 "Regexp to match names of local hosts.
|
|
|
1117 These are hosts to which it is possible to obtain a direct internet
|
|
|
1118 connection. Even if the host is accessible by a very transparent FTP gateway,
|
|
|
1119 it does not qualify as a local host. The test to determine if machine A is
|
|
|
1120 local to your machine is if it is possible to ftp from A _back_ to your
|
|
|
1121 local machine. Also, open-network-stream must be able to reach the host
|
|
|
1122 in question.")
|
|
|
1123
|
|
|
1124 (defvar efs-ftp-local-host-regexp ".*"
|
|
|
1125 "Regexp to match the names of hosts reachable by a direct ftp connection.
|
|
|
1126 This regexp should match the names of hosts which can be reached using ftp,
|
|
|
1127 without requiring any explicit connection to a gateway. If you have a smart
|
|
|
1128 ftp client which is able to transparently go through a gateway, this will
|
|
|
1129 differ from `efs-local-host-regexp'.")
|
|
|
1130
|
|
|
1131 (defvar efs-gateway-host nil
|
|
|
1132 "If non-nil, this must be the name of your ftp gateway machine.
|
|
|
1133 If your net world is divided into two domains according to
|
|
|
1134 `efs-local-ftp-host-regexp', set this variable to the name of the
|
|
|
1135 gateway machine.")
|
|
|
1136
|
|
|
1137 (defvar efs-gateway-type nil
|
|
|
1138 "Specifies which type of gateway you wish efs to use.
|
|
|
1139 This should be a list, the first element of which is a symbol denoting the
|
|
|
1140 gateway type, and following elements give data on how to use the gateway.
|
|
|
1141
|
|
|
1142 The following possibilities are supported:
|
|
|
1143
|
|
|
1144 '(local FTP-PROGRAM FTP-PROGRAM-ARGS)
|
|
|
1145 This means that your local host is itself the gateway. However,
|
|
|
1146 you need to run a special FTP client to access outside hosts.
|
|
|
1147 FTP-PROGRAM should be the name of this FTP client, and FTP-PROGRAM-ARGS
|
|
|
1148 is a list of arguments to pass to it \(probably set this to the value of
|
|
|
1149 efs-ftp-program-args <V>\). Note that if your gateway is of this type,
|
|
|
1150 then you would set efs-gateway-host to nil.
|
|
|
1151
|
|
|
1152 '(proxy FTP-PROGRAM FTP-PROGRAM-ARGS)
|
|
|
1153 This indicates that your gateway works by first FTP'ing to it, and
|
|
|
1154 then giving a USER command of the form \"USER <username>@<host>\".
|
|
|
1155 FTP-PROGRAM is the FTP program to use to connect to the gateway; this
|
|
|
1156 is most likely \"ftp\". FTP-PROGRAM-ARGS is a list of arguments to
|
|
|
1157 pass to it. You likely want this to be set to the value of
|
|
|
1158 efs-ftp-program-args <V>. If the connection to the gateway FTP server
|
|
|
1159 is to be on a port different from 21, set efs-gateway-host to
|
|
|
1160 \"<host>#<port>\".
|
|
|
1161
|
|
|
1162 '(raptor FTP-PROGRAM FTP-PROGRAM-ARGS USER)
|
|
|
1163 This is for the gateway called raptor by Eagle. After connecting to the
|
|
|
1164 the gateway, the command \"user <user>@host USER\" is issued to login
|
|
|
1165 as <user> on <host>, where USER is an authentication username for the
|
|
|
1166 gateway. After issuing the password for the remote host, efs will
|
|
|
1167 send the password for USER on efs-gateway-host <V> as an account command.
|
|
|
1168
|
|
|
1169 '(interlock FTP-PROGRAM FTP-PROGRAM-ARGS)
|
|
|
1170 This is for the interlock gateway. The exact login sequence is to
|
|
|
1171 connect to the gateway specified by efs-gateway-host <V>, send the
|
|
|
1172 gateway password with a PASS command, send the command
|
|
|
1173 \"user <user>@<host>\" to connect to remote host <host> as user <user>,
|
|
|
1174 and finally to send the password for <user> on <host> with a second
|
|
|
1175 PASS command.
|
|
|
1176
|
|
|
1177 '(kerberos FTP-PROGRAM FTP-PROGRAM-ARGS KINIT-PROGRAM KINIT-PROGRAM-ARGS)
|
|
|
1178 This is for the kerberos gateway where you need to run a program (kinit) to
|
|
|
1179 obtain a ticket for gateway authroization first. FTP-PROGRAM should be
|
|
|
1180 the name of the FTP client that you use to connect to the gateway. This
|
|
|
1181 may likely be \"iftp\". FTP-PROGRAM-ARGS are the arguments that you need
|
|
|
1182 to pass to FTP-PROGRAM. This is probably the value of
|
|
|
1183 efs-ftp-program-args <V>. KINIT-PROGRAM is the name of the program to
|
|
|
1184 run in order to obtain a ticket. This is probably \"kinit\".
|
|
|
1185 KINIT-PROGRAM-ARGS is a list og strings indicating any arguments that you
|
|
|
1186 need to pass to KINIT-PROGRAM. Most likely this is nil.
|
|
|
1187
|
|
|
1188 '(remsh GATEWAY-PROGRAM GATEWAY-PROGRAM-ARGS FTP-PROGRAM FTP-PROGRAM-ARGS)
|
|
|
1189 This indicates that you wish to run FTP on your gateway using a remote shell.
|
|
|
1190 GATEWAY-PROGRAM is the name of the program to use to start a remote shell.
|
|
|
1191 It is assumed that it is not necessary to provide a password to start
|
|
|
1192 this remote shell. Likely values are \"remsh\" or \"rsh\".
|
|
|
1193 GATEWAY-PROGRAM-ARGS is a list of arguments to pass to GATEWAY-PROGRAM.
|
|
|
1194 FTP-PROGRAM is the name of the FTP program on the gateway. A likely setting
|
|
|
1195 of this is \"ftp\". FTP-PROGRAM-ARGS is a list of arguments to pass to
|
|
|
1196 FTP-PROGRAM. Most likely these should be set to the value of
|
|
|
1197 efs-ftp-program-args <V>.
|
|
|
1198
|
|
|
1199 '(interactive GATEWAY-PROGRAM GATEWAY-PROGRAM-ARGS FTP-PROGRAM
|
|
|
1200 FTP-PROGRAM-ARGS)
|
|
|
1201 This indicates that you need to start an interactive login on your gatway,
|
|
|
1202 using rlogin, telnet, or something similar. GATEWAY-PROGRAM is the name
|
|
|
1203 of the program to use to log in to the gateway, and GATEWAY-PROGRAM-ARGS
|
|
|
1204 is a list of arguments to pass to it. FTP-PROGRAM is the name of the FTP
|
|
|
1205 program on the gateway. A likely setting for this variable would be
|
|
|
1206 \"exec ftp\". FTP-PROGRAM-ARGS is a list of arguments to pass
|
|
|
1207 to FTP-PROGRAM. You probably want to set these to the same value as
|
|
|
1208 efs-ftp-program-args <V>. If you are using this option, read the
|
|
|
1209 documentation at the top of efs-gwp.el, and see
|
|
|
1210 efs-gwp-setup-term-command <V>.")
|
|
|
1211
|
|
|
1212 (defvar efs-gateway-hash-mark-size nil
|
|
|
1213 "*Value of `efs-hash-mark-size' for FTP clients on `efs-gateway-host'.
|
|
|
1214 See the documentation of these variables for more information.")
|
|
|
1215
|
|
|
1216 (defvar efs-gateway-incoming-binary-hm-size nil
|
|
|
1217 "*Value of `efs-incoming-binary-hm-size' for `efs-gateway-host'.
|
|
|
1218 See documentation of these variables for more information.")
|
|
|
1219
|
|
|
1220 (defvar efs-gateway-tmp-name-template "/tmp/efs"
|
|
|
1221 "Template used to create temporary files when ftp-ing through a gateway.
|
|
|
1222 This should be the name of the file on the gateway, and not necessarily
|
|
|
1223 the name on the local host.")
|
|
|
1224
|
|
|
1225 (defvar efs-gateway-mounted-dirs-alist nil
|
|
|
1226 "An alist of directories cross-mounted between the gateway and local host.
|
|
|
1227 Each entry is of the form \( DIR1 . DIR2 \), where DIR1 is the name of the
|
|
|
1228 directory on the local host, and DIR2 is its name on the remote host. Both
|
|
|
1229 DIR1 and DIR2 must be specified in directory syntax, i.e. end in a slash.
|
|
|
1230 Note that we will assume that subdirs of DIR1 and DIR2 are also accessible
|
|
|
1231 on both machines.")
|
|
|
1232
|
|
|
1233 (defvar efs-gateway-ftp-prompt-regexp "^\\(ftp\\|Ftp\\|FTP\\)> *"
|
|
|
1234 "*Regular expression to match the prompt of the gateway FTP client.")
|
|
|
1235
|
|
|
1236 ;;; End of gateway config variables.
|
|
|
1237
|
|
|
1238 (defvar efs-tmp-name-template "/tmp/efs"
|
|
|
1239 "Template used to create temporary files.
|
|
|
1240 If you are worried about security, make this a directory in some
|
|
|
1241 bomb-proof cave somewhere. efs does clean up its temp files, but
|
|
|
1242 they do live for short periods of time.")
|
|
|
1243
|
|
|
1244 (defvar efs-generate-anonymous-password t
|
|
|
1245 "*If t, use a password of `user@host' when logging in as the anonymous user.
|
|
|
1246 `host' is generated by the function `efs-system-fqdn'. If `system name' returns
|
|
|
1247 a fully qualified domain name, `efs-system-fqdn' will return this. Otherwise,
|
|
|
1248 it will attempt to use nslookup to obtain a fully qualified domain name. If
|
|
|
1249 this is unsuccessful, the returned value will be the same as `system-name',
|
|
|
1250 whether this is a fully qualified domain name or not.
|
|
|
1251
|
|
|
1252 If a string then use that as the password.
|
|
|
1253
|
|
|
1254 If nil then prompt the user for a password.
|
|
|
1255
|
|
|
1256 Beware that some operating systems, such as MVS, restrict substantially
|
|
|
1257 the password length. The login will fail with a weird error message
|
|
|
1258 if you exceed it.")
|
|
|
1259
|
|
|
1260 (defvar efs-high-security-hosts nil
|
|
|
1261 "*Indicates host user pairs for which passwords should not be cached.
|
|
|
1262 If non-nil, should be a regexp matching user@host constructions for which
|
|
|
1263 efs should not store passwords in its internal cache.")
|
|
|
1264
|
|
|
1265 ;; The following regexps are tested in the following order:
|
|
|
1266 ;; efs-binary-file-host-regexp, efs-36-bit-binary-file-name-regexp,
|
|
|
1267 ;; efs-binary-file-name-regexp, efs-text-file-name-regexp.
|
|
|
1268 ;; File names which match nothing are transferred in 'image mode.
|
|
|
1269
|
|
|
1270 ;; If we're not careful, we're going to blow the regexp stack here.
|
|
|
1271 ;; Probably should move to a list of regexps. Slower, but safer.
|
|
|
1272 ;; This is not a problem in Emacs 19.
|
|
|
1273 (defvar efs-binary-file-name-regexp
|
|
|
1274 (concat "\\." ; the dot
|
|
|
1275 ;; extensions
|
|
|
1276 "\\([zZ]\\|t?gz\\|lzh\\|arc\\|zip\\|zoo\\|ta[rz]\\|dvi\\|sit\\|"
|
|
|
1277 "ps\\|elc\\|gif\\|Z-part-..\\|tpz\\|exe\\|[jm]pg\\|TZ[a-z]?\\|lib\\)"
|
|
|
1278 "\\(~\\|~[0-9]+~\\)?$" ; backups
|
|
|
1279 "\\|"
|
|
|
1280 ;; UPPER CASE LAND
|
|
|
1281 "\\."
|
|
|
1282 "\\(ARC\\|ELC\\|TAGS\\|EXE\\|ZIP\\|DVI\|ZOO\\|GIF\\|T?GZ\\|"
|
|
|
1283 "[JM]PG\\)"
|
|
|
1284 "\\([.#;][0-9]+\\)?$" ; versions
|
|
|
1285 )
|
|
|
1286 "*Files whose names match this regexp will be considered to be binary.
|
|
|
1287 By binary here, we mean 8-bit binary files (the usual unix binary files).
|
|
|
1288 If nil, no files will be considered to be binary.")
|
|
|
1289
|
|
|
1290 (defvar efs-binary-file-host-regexp nil
|
|
|
1291 "*All files on hosts matching this regexp are treated as 8-bit binary.
|
|
|
1292 Setting this to nil, inhibits this feature.")
|
|
|
1293
|
|
|
1294 (defvar efs-36-bit-binary-file-name-regexp nil
|
|
|
1295 "*Files whose names match this regexp will be considered to PDP 10 binaries.
|
|
|
1296 These are 36-bit word-aligned binary files. This is really only relevant for
|
|
|
1297 files on PDP 10's, and similar machines. If nil, no files will be considered
|
|
|
1298 to be PDP 10 binaries.")
|
|
|
1299
|
|
|
1300 (defvar efs-text-file-name-regexp ".*"
|
|
|
1301 "*Files whose names match this regexp will be considered to be text files.")
|
|
|
1302
|
|
|
1303 (defvar efs-prompt-for-transfer-type nil
|
|
|
1304 "*If non-nil, efs will prompt for the transfer type for each file transfer.
|
|
|
1305 The command efs-prompt-for-transfer-type can be used to toggle its value.")
|
|
|
1306
|
|
|
1307 (defvar efs-treat-crlf-as-nl nil
|
|
|
1308 "*Controls how file systems using CRLF as end of line are treated.
|
|
|
1309 If non-nil, such file systems will be considered equivalent to those which use
|
|
|
1310 LF as end of line. This is particularly relevant to transfers between DOS
|
|
|
1311 systems and UNIX. Setting this to be non-nil will cause all file transfers
|
|
|
1312 between DOS and UNIX systems to use be image or binary transfers.")
|
|
|
1313
|
|
|
1314 (defvar efs-send-hash t
|
|
|
1315 "*If non-nil, send the HASH command to the FTP client.")
|
|
|
1316
|
|
|
1317 (defvar efs-hash-mark-size nil
|
|
|
1318 "*Default size, in bytes, between hash-marks when transferring a file.
|
|
|
1319 If this is nil then efs will attempt to assign a value based on the
|
|
|
1320 output of the HASH command. Also, if this variable is incorrectly set,
|
|
|
1321 then efs will try to correct it based on the size of the last file
|
|
|
1322 transferred, and the number hashes outputed by the client during the
|
|
|
1323 transfer.
|
|
|
1324
|
|
|
1325 The variable `efs-gateway-hash-mark-size' defines the corresponding value
|
|
|
1326 for the FTP client on the gateway, if you are using a gateway.
|
|
|
1327
|
|
|
1328 Some client-server combinations do not correctly compute the number of hash
|
|
|
1329 marks for incoming binary transfers. In this case, a separate variable
|
|
|
1330 `efs-incoming-binary-hm-size' can be used to set a default value of the
|
|
|
1331 hash mark size for incoming binary transfers.")
|
|
|
1332
|
|
|
1333 (defvar efs-incoming-binary-hm-size nil
|
|
|
1334 "*Default hash mark size for incoming binary transfers.
|
|
|
1335 If this is nil, incoming binary transfers will use `efs-hash-mark-size' as
|
|
|
1336 the default. See the documentation of this variable for more details.")
|
|
|
1337
|
|
|
1338 (defvar efs-verbose t
|
|
|
1339 "*If non-NIL then be chatty about interaction with the FTP process.
|
|
|
1340 If 0 do not give % transferred reports for asynchronous commands and status
|
|
|
1341 reports for commands verifying file modtimes, but report on everything else.")
|
|
|
1342
|
|
|
1343 (defvar efs-message-interval 0
|
|
|
1344 "*Defines the minimum time in seconds between status messages.
|
|
|
1345 A new status message is not displayed, if one has already been given
|
|
|
1346 within this period of time.")
|
|
|
1347
|
|
|
1348 (defvar efs-max-ftp-buffer-size 3000
|
|
|
1349 "*Maximum size in characters of FTP process buffer, before it is trimmed.
|
|
|
1350 The buffer is trimmed to approximately half this size. Setting this to nil
|
|
|
1351 inhibits trimming of FTP process buffers.")
|
|
|
1352
|
|
|
1353 (defvar efs-ls-cache-max 5
|
|
|
1354 "*Maximum number of directory listings to be cached in efs-ls-cache.")
|
|
|
1355
|
|
|
1356 (defvar efs-mode-line-format " ftp(%d)"
|
|
|
1357 "Format string used to determine how FTP activity is shown on the mode line.
|
|
|
1358 It is passed to format, with second argument the number of active FTP
|
|
|
1359 sessions as an integer.")
|
|
|
1360
|
|
|
1361 (defvar efs-show-host-type-in-dired t
|
|
|
1362 "If non-nil, show the system type on the mode line of remote dired buffers.")
|
|
|
1363
|
|
|
1364 (defvar efs-ftp-activity-function nil
|
|
|
1365 "Function called to indicate FTP activity.
|
|
|
1366 It must have exactly one argument, the number of active FTP sessions as an
|
|
|
1367 integer.")
|
|
|
1368
|
|
|
1369 (defvar efs-ftp-program-name "ftp"
|
|
|
1370 "Name of FTP program to run.")
|
|
|
1371
|
|
|
1372 (defvar efs-ftp-program-args '("-i" "-n" "-g" "-v")
|
|
|
1373 "*A list of arguments passed to the FTP program when started.")
|
|
|
1374
|
|
|
1375 (defvar efs-ftp-prompt-regexp "^\\(ftp\\|Ftp\\|FTP\\)> *"
|
|
|
1376 "*Regular expression to match the prompt of your FTP client.")
|
|
|
1377
|
|
|
1378 (defvar efs-nslookup-program "nslookup"
|
|
|
1379 "*If non-NIL then a string naming nslookup program." )
|
|
|
1380
|
|
|
1381 (defvar efs-nslookup-on-connect nil
|
|
|
1382 "*If non-NIL then use nslookup to resolve the host name before connecting.")
|
|
|
1383
|
|
|
1384 (defvar efs-nslookup-threshold 1000
|
|
|
1385 "How many iterations efs waits on the nslookup program.
|
|
|
1386 Applies when nslookup is used to compute a fully qualified domain name
|
|
|
1387 for the local host, in the case when `system-name' does not return one.
|
|
|
1388 If you set this to nil, efs will wait an arbitrary amount of time to get
|
|
|
1389 output.")
|
|
|
1390
|
|
48
|
1391 (defvar efs-remote-shell-file-name
|
|
|
1392 (if (memq system-type '(hpux usg-unix-v)) ; hope that's right
|
|
|
1393 "remsh"
|
|
|
1394 "rsh")
|
|
|
1395 "Remote shell used by efs.")
|
|
|
1396
|
|
|
1397 (defvar efs-remote-shell-takes-user
|
|
|
1398 (null (null (memq system-type '(aix aix-v3 hpux silicon-graphics-unix
|
|
|
1399 berkeley-unix))))
|
|
|
1400 ;; Complete? Doubt it.
|
|
|
1401 "Set to non-nil if your remote shell command takes \"-l USER\".")
|
|
|
1402
|
|
22
|
1403 (defvar efs-make-backup-files efs-unix-host-types
|
|
|
1404 "*A list of operating systems for which efs will make Emacs backup files.
|
|
|
1405 The backup files are made on the remote host.
|
|
|
1406
|
|
|
1407 For example:
|
|
|
1408 '\(unix sysV-unix bsd-unix apollo-unix dumb-unix\) makes sense, but
|
|
|
1409 '\(unix vms\) would be silly, since vms makes its own backups.")
|
|
|
1410
|
|
|
1411 ;; Is this variable really useful? We should try to figure a way to
|
|
|
1412 ;; do local copies on a remote machine that doesn't take forever.
|
|
|
1413 (defvar efs-backup-by-copying nil
|
|
|
1414 "*Version of `backup by copying' for remote files.
|
|
|
1415 If non-nil, remote files will be backed up by copying, instead of by renaming.
|
|
|
1416 Note the copying will be done by moving the file through the local host -- a
|
|
|
1417 very time consuming operation.")
|
|
|
1418
|
|
|
1419 ;;; Auto-save variables. Relevant for auto-save.el
|
|
|
1420
|
|
|
1421 (defvar efs-auto-save 0
|
|
|
1422 "*If 1, allows efs files to be auto-saved.
|
|
|
1423 If 0, suppresses auto-saving of efs files.
|
|
|
1424 Don't use any other value.")
|
|
|
1425
|
|
|
1426 (defvar efs-auto-save-remotely nil
|
|
|
1427 "*Determines where remote files are auto-saved.
|
|
|
1428
|
|
|
1429 If nil, auto-saves for remote files will be written in `auto-save-directory'
|
|
|
1430 or `auto-save-directory-fallback' if this isn't defined.
|
|
|
1431
|
|
|
1432 If non-nil, causes the auto-save file for an efs file to be written in
|
|
|
1433 the remote directory containing the file, rather than in a local directory.
|
|
|
1434 For remote files, this overrides a non-nil `auto-save-directory'. Local files
|
|
|
1435 are unaffected. If you want to use this feature, you probably only want to
|
|
|
1436 set this true in a few buffers, rather than globally. You might want to give
|
|
|
1437 each buffer its own value using `make-variable-buffer-local'. It is usually
|
|
|
1438 a good idea to auto-save remote files locally, because it is not only faster,
|
|
|
1439 but provides protection against a connection going down.
|
|
|
1440
|
|
|
1441 See also variable `efs-auto-save'.")
|
|
|
1442
|
|
|
1443 (defvar efs-short-circuit-to-remote-root nil
|
|
|
1444 "*Defines whether \"//\" short-circuits to the remote or local root.")
|
|
|
1445
|
|
|
1446 ;; Can we somehow grok this from system type? No.
|
|
|
1447 (defvar efs-local-apollo-unix
|
|
|
1448 (eq 0 (string-match "//" (or (getenv "HOME") (getenv "SHELL") "")))
|
|
|
1449 "*Defines whether the local machine is an apollo running Domain.
|
|
|
1450 This variable has nothing to do with efs, and should be basic to all
|
|
|
1451 of emacs.")
|
|
|
1452
|
|
|
1453 (defvar efs-root-umask nil
|
|
|
1454 "*umask to use for root logins.")
|
|
|
1455
|
|
|
1456 (defvar efs-anonymous-umask nil
|
|
|
1457 "*umask to use for anonymous logins.")
|
|
|
1458
|
|
|
1459 (defvar efs-umask nil
|
|
|
1460 "*umask to use for efs sessions.
|
|
|
1461 If this is nil, then the setting of umask on the local host is used.")
|
|
|
1462
|
|
|
1463 ;; Eliminate these variables when Sun gets around to getting its FTP server
|
|
|
1464 ;; out of the stone age.
|
|
|
1465 (defvar efs-ding-on-umask-failure t
|
|
|
1466 "*Ring the bell if the umask command fails on a unix host. Many servers don't
|
|
|
1467 support this command, so if you get a lot of annoying failures, set this
|
|
|
1468 to nil.")
|
|
|
1469
|
|
|
1470 (defvar efs-ding-on-chmod-failure t
|
|
|
1471 "*Ring the bell if the chmod command fails on a unix host. Some servers don't
|
|
|
1472 support this command, so if you get a lot of annoying failures, set this
|
|
|
1473 to nil.")
|
|
|
1474
|
|
|
1475 ;; Please let us know if you can contribute more entries to this guessing game.
|
|
|
1476 (defvar efs-nlist-cmd
|
|
|
1477 (cond
|
|
|
1478 ;; Covers Ultrix, SunOS, and NeXT.
|
|
|
1479 ((eq system-type 'berkeley-unix)
|
|
|
1480 "ls")
|
|
|
1481 ((memq system-type '(hpux aix-v3 silicon-graphics-unix))
|
|
|
1482 "nlist")
|
|
|
1483 ;; Blind guess
|
|
|
1484 ("ls"))
|
|
|
1485 "*FTP client command for getting a brief listing (NLST) from the FTP server.
|
|
|
1486 We try to guess this based on the local system-type, but obviously if you
|
|
|
1487 are using a gateway, you'll have to set it yourself.")
|
|
|
1488
|
|
|
1489 (defvar efs-compute-remote-buffer-file-truename nil
|
|
|
1490 "*If non-nil, `buffer-file-truename' will be computed for remote buffers.
|
|
|
1491 In emacs 19, each buffer has a local variable, `buffer-file-truename',
|
|
|
1492 which is used to ensure that symbolic links will not confuse emacs into
|
|
|
1493 visiting the same file with two buffers. This variable is computed by
|
|
|
1494 chasing all symbolic links in `buffer-file-name', both at the level of the
|
|
|
1495 file and at the level of all parent directories. Since this operation can be
|
|
|
1496 very time-consuming over FTP, this variable can be used to inhibit it.")
|
|
|
1497
|
|
|
1498 (defvar efs-buffer-name-case nil
|
|
|
1499 "*Selects the case used for buffer names of case-insensitive file names.
|
|
|
1500 Case-insensitive file names are files on hosts whose host type is in
|
|
|
1501 `efs-case-insensitive-host-types'.
|
|
|
1502
|
|
|
1503 If this is 'up upper case is used, if it is 'down lower case is used.
|
|
|
1504 If this has any other value, the case is inherited from the name used
|
|
|
1505 to access the file.")
|
|
|
1506
|
|
|
1507 (defvar efs-fancy-buffer-names "%s@%s"
|
|
|
1508 "Format used to compute names of buffers attached to remote files.
|
|
|
1509
|
|
|
1510 If this is nil, buffer names are computed in the usual way.
|
|
|
1511
|
|
|
1512 If it is a string, then the it is passed to format with second and third
|
|
|
1513 arguments the host name and file name.
|
|
|
1514
|
|
|
1515 Otherwise, it is assumed to be function taking three arguments, the host name,
|
|
|
1516 the user name, and the truncated file name. It should returns the name to
|
|
|
1517 be used for the buffer.")
|
|
|
1518
|
|
|
1519 (defvar efs-verify-anonymous-modtime nil
|
|
|
1520 "*Determines if efs checks modtimes for remote files on anonymous logins.
|
|
|
1521 If non-nil, efs runs `verify-visited-file-modtime' for remote files on
|
|
|
1522 anonymous ftp logins. Since verify-visited-file-modtime slows things down,
|
|
|
1523 and most people aren't editing files on anonymous ftp logins, this is nil
|
|
|
1524 by default.")
|
|
|
1525
|
|
|
1526 (defvar efs-verify-modtime-host-regexp ".*"
|
|
|
1527 "*Regexp to match host names for which efs checks file modtimes.
|
|
|
1528 If non-nil, efs will run `verify-visited-file-modtime' for remote
|
|
|
1529 files on hosts matching this regexp. If nil, verify-visited-file-modtime
|
|
|
1530 is supressed for all remote hosts. This is tested before
|
|
|
1531 `efs-verify-anonymous-modtime'.")
|
|
|
1532
|
|
|
1533 (defvar efs-maximize-idle nil
|
|
|
1534 "*If non-nil, efs will attempt to maximize the idle time out period.
|
|
|
1535 At some idle moment in the connection after login, efs will attempt to
|
|
|
1536 set the idle time out period to the maximum amount allowed by the server.
|
|
|
1537 It applies only to non-anonymous logins on unix hosts.")
|
|
|
1538
|
|
|
1539 (defvar efs-expire-ftp-buffers t
|
|
|
1540 "*If non-nil ftp buffers will be expired.
|
|
|
1541 The buffers will be killed either after `efs-ftp-buffer-expire-time' has
|
|
|
1542 elapsed with no activity, or the remote FTP server has timed out.")
|
|
|
1543
|
|
|
1544 (defvar efs-ftp-buffer-expire-time nil
|
|
|
1545 "*If non-nil, the time after which ftp buffers will be expired.
|
|
|
1546 If nil, ftp buffers will be expired only when the remote server has timed out.
|
|
|
1547 If an integer, ftp buffers will be expired either when the remote server
|
|
|
1548 has timed out, or when this many seconds on inactivity has elapsed.")
|
|
|
1549
|
|
|
1550 ;; If you need to increase this variable much, it is likely that
|
|
|
1551 ;; the true problem is timing errors between the efs process filter
|
|
|
1552 ;; and the FTP server. This could either be caused by the server
|
|
|
1553 ;; not following RFC959 response codes, or a bug in efs. In either
|
|
|
1554 ;; case please report the problem to us. If it's a bug, we'll fix it.
|
|
|
1555 ;; If the server is at fault we may try to do something. Our rule
|
|
|
1556 ;; of thumb is that we will support non-RFC959 behaviour, as long as
|
|
|
1557 ;; it doesn't risk breaking efs for servers which behave properly.
|
|
|
1558
|
|
|
1559 (defvar efs-retry-time 5
|
|
|
1560 "*Number of seconds to wait before retrying if data doesn't arrive.
|
|
|
1561 The FTP command isn't retried, rather efs just takes a second look
|
|
|
1562 for the data file. This might need to be increased for very slow FTP
|
|
|
1563 clients.")
|
|
|
1564
|
|
|
1565 (defvar efs-pty-check-threshold 1000
|
|
|
1566 "*How long efs waits before deciding that it doesn't have a pty.
|
|
|
1567 Specifically it is the number of iterations through `accept-process-output'
|
|
|
1568 that `efs-pty-p' waits before deciding that the pty is really a pipe.
|
|
|
1569 Set this to nil to inhibit checking for pty's. If efs seems to be
|
|
|
1570 mistaking some pty's for pipes, try increasing this number.")
|
|
|
1571
|
|
|
1572 (defvar efs-pty-check-retry-time 5
|
|
|
1573 "*Number of seconds that efs waits before retrying a pty check.
|
|
|
1574 This can be lengthened, if your FTP client is slow to start.")
|
|
|
1575
|
|
|
1576 (defvar efs-suppress-abort-recursive-edit-and-then nil
|
|
|
1577 "*If non-nil, `efs-abort-recursive-edit-and-then' will not run its function.
|
|
|
1578 This means that when a recursive edit is in progress, automatic popping of the
|
|
|
1579 FTP process buffer, and automatic popping of the bug report buffer will not
|
|
|
1580 work. `efs-abort-recursive-edit-and-then' works by forking a \"sleep 0\"
|
|
|
1581 process. On some unix implementations the forked process might be of the same
|
|
|
1582 size as the original GNU Emacs process. Forking such a large process just to
|
|
|
1583 do a \"sleep 0\" is probably not good.")
|
|
|
1584
|
|
|
1585 (defvar efs-ftp-buffer-format "*ftp %s@%s*"
|
|
|
1586 "Format to construct the name of FTP process buffers.
|
|
|
1587 This string is fed to `format' with second and third arguments the user
|
|
|
1588 name and host name.")
|
|
|
1589 ;; This does not affect the process name of the FTP client process.
|
|
|
1590 ;; That is always *ftp USER@HOST*
|
|
|
1591
|
|
|
1592 (defvar efs-debug-ftp-connection nil
|
|
|
1593 "*If non-nil, the user will be permitted to debug the FTP connection.
|
|
|
1594 This means that typing a C-g to the FTP process filter will give the user
|
|
|
1595 the option to type commands at the FTP connection. Normally, the connection
|
|
|
1596 is killed first. Note that doing this may result in the FTP process filter
|
|
|
1597 getting out of synch with the FTP client, so using this feature routinely
|
|
|
1598 isn't recommended.")
|
|
|
1599
|
|
48
|
1600 (defvar efs-use-passive-mode nil
|
|
|
1601 "*If non-nil, the ftp client will specify passive mode for all transfers.")
|
|
|
1602
|
|
22
|
1603 ;;; Hooks and crooks.
|
|
|
1604
|
|
|
1605 (defvar efs-ftp-startup-hook nil
|
|
|
1606 "Hook to run immediately after starting the FTP client.
|
|
|
1607 This hook is run before the FTP OPEN command is sent.")
|
|
|
1608
|
|
|
1609 (defvar efs-ftp-startup-function-alist nil
|
|
|
1610 "Association list of functions to running after FTP login.
|
|
|
1611 This should be an alist of the form '\(\(REGEXP . FUNCTION\) ...\), where
|
|
|
1612 REGEXP is a regular expression matched against the name of the remote host,
|
|
|
1613 and FUNCTION is a function of two arguments, HOST and USER. REGEXP is
|
|
|
1614 compared to the host name with `case-fold-search' bound to t. Only the first
|
|
|
1615 match in the alist is run.")
|
|
|
1616
|
|
|
1617 (defvar efs-load-hook nil
|
|
|
1618 "Hook to run immediately after loading efs.el.
|
|
|
1619 You can use it to alter definitions in efs.el, but why would you want
|
|
|
1620 to do such a thing?")
|
|
|
1621
|
|
|
1622 ;;;; -----------------------------------------------------------
|
|
|
1623 ;;;; Regexps for parsing FTP server responses.
|
|
|
1624 ;;;; -----------------------------------------------------------
|
|
|
1625 ;;;
|
|
|
1626 ;;; If you have to tune these variables, please let us know, so that
|
|
|
1627 ;;; we can get them right in the next release.
|
|
|
1628
|
|
|
1629 (defvar efs-multi-msgs
|
|
|
1630 ;; RFC959 compliant codes
|
|
|
1631 "^[1-5][0-5][0-7]-")
|
|
|
1632 ;; Regexp to match the start of an FTP server multiline reply.
|
|
|
1633
|
|
|
1634 (defvar efs-skip-msgs
|
|
|
1635 ;; RFC959 compliant codes
|
|
|
1636 (concat
|
|
|
1637 "^110 \\|" ; Restart marker reply.
|
|
|
1638 "^125 \\|" ; Data connection already open; transfer starting.
|
|
|
1639 "^150 ")) ; File status OK; about to open connection.
|
|
|
1640 ;; Regexp to match an FTP server response which we wish to ignore.
|
|
|
1641
|
|
|
1642 (defvar efs-cmd-ok-msgs
|
|
|
1643 ;; RFC959 compliant
|
|
|
1644 "^200 \\|^227 ")
|
|
|
1645 ;; Regexp to match the server command OK response.
|
|
|
1646 ;; Because PORT commands return this we usually ignore it. However, it is
|
|
|
1647 ;; a valid response for TYPE, SITE, and a few other commands (cf. RFC 959).
|
|
|
1648 ;; If we are explicitly sending a PORT, or one of these other commands,
|
|
|
1649 ;; then we don't want to ignore this response code. Also use this to match
|
|
|
1650 ;; the return code for PASV, as some clients burp these things out at odd
|
|
|
1651 ;; times.
|
|
|
1652
|
|
|
1653 (defvar efs-pending-msgs
|
|
|
1654 ;; RFC959 compliant
|
|
|
1655 "^350 ") ; Requested file action, pending further information.
|
|
|
1656 ;; Regexp to match the \"requested file action, pending further information\"
|
|
|
1657 ;; message. These are usually ignored, except if we are using RNFR to test for
|
|
|
1658 ;; file existence.
|
|
|
1659
|
|
|
1660 (defvar efs-cmd-ok-cmds
|
|
|
1661 (concat
|
|
|
1662 "^quote port \\|^type \\|^quote site \\|^chmod \\|^quote noop\\|"
|
|
48
|
1663 "^quote pasv\\|^passive"))
|
|
22
|
1664 ;; Regexp to match commands for which efs-cmd-ok-msgs is a valid server
|
|
|
1665 ;; response for success.
|
|
|
1666
|
|
|
1667 (defvar efs-passwd-cmds
|
|
|
1668 "^quote pass \\|^quote acct \\|^quote site gpass ")
|
|
|
1669 ;; Regexp to match commands for sending passwords.
|
|
|
1670 ;; All text following (match-end 0) will be replaced by "Turtle Power!"
|
|
|
1671
|
|
|
1672 (defvar efs-bytes-received-msgs
|
|
|
1673 ;; Strictly a client response
|
|
|
1674 "^[0-9]+ bytes ")
|
|
|
1675 ;; Regexp to match the reply from the FTP client that it has finished
|
|
|
1676 ;; receiving data.
|
|
|
1677
|
|
|
1678 (defvar efs-server-confused-msgs
|
|
|
1679 ;; ka9q uses this to indicate an incorrectly set transfer mode, and
|
|
|
1680 ;; then does send a second completion code for the command. This does
|
|
|
1681 ;; *not* conform to RFC959.
|
|
|
1682 "^100 Warning: type is ")
|
|
|
1683 ;; Regexp to match non-standard response from the FTP server. This can
|
|
|
1684 ;; sometimes be the result of an incorrectly set transfer mode. In this case
|
|
|
1685 ;; we do not rely on the server to tell us when the data transfer is complete,
|
|
|
1686 ;; but check with the client.
|
|
|
1687
|
|
|
1688 (defvar efs-good-msgs
|
|
|
1689 (concat
|
|
|
1690 ;; RFC959 compliant codes
|
|
|
1691 "^2[01345][0-7] \\|" ; 2yz = positive completion reply
|
|
|
1692 "^22[02-7] \\|" ; 221 = successful logout
|
|
|
1693 ; (Sometimes get this with a timeout,
|
|
|
1694 ; so treat as fatal.)
|
|
|
1695 "^3[0-5][0-7] \\|" ; 3yz = positive intermediate reply
|
|
48
|
1696 ;; passive
|
|
|
1697 "^[Pp]assive \\|"
|
|
22
|
1698 ;; client codes
|
|
|
1699 "^[Hh]ash mark "))
|
|
|
1700 ;; Response to indicate that the requested action was successfully completed.
|
|
|
1701
|
|
|
1702 (defvar efs-failed-msgs
|
|
|
1703 (concat
|
|
|
1704 ;; RFC959 compliant codes
|
|
|
1705 "^120 \\|" ; Service ready in nnn minutes.
|
|
|
1706 "^450 \\|" ; File action not taken; file is unavailable, or busy.
|
|
|
1707 "^452 \\|" ; Insufficient storage space on system.
|
|
|
1708 "^5[0-5][0-7] \\|" ; Permanent negative reply codes.
|
|
|
1709 ;; When clients tell us that a file doesn't exist, or can't access.
|
|
|
1710 "^\\(local: +\\)?/[^ ]* +"
|
|
|
1711 "\\([Nn]o such file or directory\\|[Nn]ot a plain file\\|"
|
|
|
1712 "The file access permissions do not allow \\|Is a directory\\b\\)"))
|
|
|
1713 ;; Regexp to match responses for failed commands. However, the ftp connection
|
|
|
1714 ;; is assumed to be good.
|
|
|
1715
|
|
|
1716 (defvar efs-fatal-msgs
|
|
|
1717 (concat
|
|
|
1718 ;; RFC959 codes
|
|
|
1719 "^221 \\|" ; Service closing control connection.
|
|
|
1720 "^421 \\|" ; Service not available.
|
|
|
1721 "^425 \\|" ; Can't open data connection.
|
|
|
1722 "^426 \\|" ; Connection closed, transfer aborted.
|
|
|
1723 "^451 \\|" ; Requested action aborted, local error in processing.
|
|
|
1724 ;; RFC959 non-compliant codes
|
|
|
1725 "^552 Maximum Idle Time Exceded\\.$\\|" ; Hellsoft server uses this to
|
|
|
1726 ; indicate a timeout. 552 is
|
|
|
1727 ; supposed to be used for exceeded
|
|
|
1728 ; storage allocation. Note that
|
|
|
1729 ; they also misspelled the error
|
|
|
1730 ; message.
|
|
|
1731 ;; client problems
|
|
|
1732 "^ftp: \\|^Not connected\\|^rcmd: \\|^No control connection\\|"
|
|
|
1733 "^unknown host\\|: unknown host$\\|^lost connection\\|"
|
|
|
1734 "^[Ss]egmentation fault\\|"
|
|
|
1735 ;; Make sure that the "local: " isn't just a message about a file.
|
|
|
1736 "^local: [^/]\\|"
|
|
|
1737 ;; Gateways
|
|
|
1738 "^iftp: cannot authenticate to server\\b"
|
|
|
1739 ))
|
|
|
1740 ;; Regexp to match responses that something has gone drastically wrong with
|
|
|
1741 ;; either the client, server, or connection. We kill the ftp process, and start
|
|
|
1742 ;; anew.
|
|
|
1743
|
|
|
1744 (defvar efs-unknown-response-msgs
|
|
|
1745 "^[0-9][0-9][0-9] ")
|
|
|
1746 ;; Regexp to match server response codes that we don't understand. This
|
|
|
1747 ;; is tested after all the other regexp, so it can match everything.
|
|
|
1748
|
|
|
1749 (defvar efs-pasv-msgs
|
|
|
1750 ;; According to RFC959.
|
|
|
1751 "^227 .*(\\([0-9]+,[0-9]+,[0-9]+,[0-9]+,[0-9]+,[0-9]+\\))$")
|
|
|
1752 ;; Matches the output of a PASV. (match-beginning 1) and (match-end 1)
|
|
|
1753 ;; must bracket the IP address and port.
|
|
|
1754
|
|
|
1755 (defvar efs-syst-msgs "^215 \\|^210 ")
|
|
|
1756 ;; 215 is RFC959. Plan 9 FTP server returns a 210. 210 is not assigned in
|
|
|
1757 ;; RFC 959.
|
|
|
1758 ;; The plan 9 people tell me that they fixed this. -- sr 18/4/94
|
|
|
1759 ;; Matches the output of a SYST.
|
|
|
1760
|
|
|
1761 (defvar efs-mdtm-msgs
|
|
|
1762 (concat
|
|
|
1763 "^213 [0-9][0-9][0-9][0-9][0-9][0-9][0-9]"
|
|
|
1764 "[0-9][0-9][0-9][0-9][0-9][0-9][0-9]$"))
|
|
|
1765 ;; Regexp to match the output of a quote mdtm command.
|
|
|
1766
|
|
|
1767 (defvar efs-idle-msgs
|
|
|
1768 "^200 [^0-9]+ \\([0-9]+\\)[^0-9]* max \\([0-9]+\\)")
|
|
|
1769 ;; Regexp to match the output of a SITE IDLE command.
|
|
|
1770 ;; Match 1 should refer to the current idle time, and match 2 the maximum
|
|
|
1771 ;; idle time.
|
|
|
1772
|
|
|
1773 (defvar efs-write-protect-msgs "^532 ") ; RFC959
|
|
|
1774 ;; Regexp to match a server ressponse to indicate that a STOR failed
|
|
|
1775 ;; because of insufficient write privileges.
|
|
|
1776
|
|
|
1777 (defvar efs-hash-mark-msgs
|
|
|
1778 "[hH]ash mark [^0-9]*\\([0-9]+\\)")
|
|
|
1779 ;; Regexp matching the FTP client's output upon doing a HASH command.
|
|
|
1780
|
|
|
1781 (defvar efs-xfer-size-msgs
|
|
|
1782 (concat
|
|
|
1783 ;; UN*X
|
|
|
1784 "^150 .* connection for .* (\\([0-9]+\\) bytes)\\|"
|
|
|
1785 ;; Wollongong VMS server.
|
|
|
1786 "^125 .* transfer started for .* (\\([0-9]+\\) bytes)\\|"
|
|
|
1787 ;; TOPS-20 server
|
|
|
1788 "^150 .* retrieve of .* ([0-9]+ pages?, \\([0-9]+\\) 7-bit bytes)"))
|
|
|
1789 ;; Regular expression used to determine the number of bytes
|
|
|
1790 ;; in a FTP transfer. The first (match-beginning #) which is non-nil is assumed
|
|
|
1791 ;; to give the size.
|
|
|
1792
|
|
|
1793 (defvar efs-expand-dir-msgs "^550 \\([^: ]+\\):")
|
|
|
1794 ;; Regexp to match the error response from a "get ~sandy".
|
|
|
1795 ;; By parsing the error, we can get a quick expansion of ~sandy
|
|
|
1796 ;; According to RFC 959, should be a 550.
|
|
|
1797
|
|
|
1798 (defvar efs-gateway-fatal-msgs
|
|
|
1799 "No route to host\\|Connection closed\\|No such host\\|Login incorrect")
|
|
|
1800 ;; Regular expression matching messages from the rlogin / telnet process that
|
|
|
1801 ;; indicates that logging in to the gateway machine has gone wrong.
|
|
|
1802
|
|
|
1803 (defvar efs-too-many-users-msgs
|
|
|
1804 ;; The test for "two many" is because some people can't spell.
|
|
|
1805 ;; I allow for up to two adjectives before "users".
|
|
|
1806 (concat
|
|
|
1807 "\\b[Tt][wo]o many\\( +[^ \n]+\\)?\\( +[^ \n]+\\)? +users\\b\\|"
|
|
|
1808 "\\btry back later\\b"))
|
|
|
1809 ;; Regular expresion to match what servers output when there are too many
|
|
|
1810 ;; anonymous logins. It is assumed that this is part of a 530 or 530- response
|
|
|
1811 ;; to USER or PASS.
|
|
|
1812
|
|
|
1813 ;;;; -------------------------------------------------------------
|
|
|
1814 ;;;; Buffer local FTP process variables
|
|
|
1815 ;;;; -------------------------------------------------------------
|
|
|
1816
|
|
|
1817 ;;; Variables buffer local to the process buffers are
|
|
|
1818 ;;; named with the prefix efs-process-
|
|
|
1819
|
|
|
1820 (defvar efs-process-q nil)
|
|
|
1821 ;; List of functions to be performed asynch.
|
|
|
1822 (make-variable-buffer-local 'efs-process-q)
|
|
|
1823
|
|
|
1824 (defvar efs-process-cmd-waiting nil)
|
|
|
1825 ;; Set to t if a process has a synchronous cmd waiting to execute.
|
|
|
1826 ;; In this case, it will allow the synch. cmd to run before returning to
|
|
|
1827 ;; the cmd queue.
|
|
|
1828 (make-variable-buffer-local 'efs-process-cmd-waiting)
|
|
|
1829
|
|
|
1830 (defvar efs-process-server-confused nil)
|
|
|
1831 (make-variable-buffer-local 'efs-process-server-confused)
|
|
|
1832
|
|
|
1833 (defvar efs-process-cmd nil)
|
|
|
1834 ;; The command currently being executed, as a string.
|
|
|
1835 (make-variable-buffer-local 'efs-process-cmd)
|
|
|
1836
|
|
|
1837 (defvar efs-process-xfer-size 0)
|
|
|
1838 (make-variable-buffer-local 'efs-process-xfer-size)
|
|
|
1839
|
|
|
1840 (defvar efs-process-umask nil)
|
|
|
1841 ;; nil if the umask hash not been set
|
|
|
1842 ;; an integer (the umask) if the umask has been set
|
|
|
1843 (make-variable-buffer-local 'efs-process-umask)
|
|
|
1844
|
|
|
1845 (defvar efs-process-idle-time nil)
|
|
|
1846 ;; If non-nil, the idle time of the server in seconds.
|
|
|
1847 (make-variable-buffer-local 'efs-process-idle-time)
|
|
|
1848
|
|
|
1849 (defvar efs-process-busy nil)
|
|
|
1850 (make-variable-buffer-local 'efs-process-busy)
|
|
|
1851
|
|
|
1852 (defvar efs-process-result-line "")
|
|
|
1853 (make-variable-buffer-local 'efs-process-result-line)
|
|
|
1854
|
|
|
1855 (defvar efs-process-result nil)
|
|
|
1856 (make-variable-buffer-local 'efs-process-result)
|
|
|
1857
|
|
|
1858 (defvar efs-process-result-cont-lines "")
|
|
|
1859 (make-variable-buffer-local 'efs-process-result-cont-lines)
|
|
|
1860
|
|
|
1861 (defvar efs-process-msg "")
|
|
|
1862 (make-variable-buffer-local 'efs-process-msg)
|
|
|
1863
|
|
|
1864 (defvar efs-process-nowait nil)
|
|
|
1865 (make-variable-buffer-local 'efs-process-nowait)
|
|
|
1866
|
|
|
1867 (defvar efs-process-string "")
|
|
|
1868 (make-variable-buffer-local 'efs-process-string)
|
|
|
1869
|
|
|
1870 (defvar efs-process-continue nil)
|
|
|
1871 (make-variable-buffer-local 'efs-process-continue)
|
|
|
1872
|
|
|
1873 (defvar efs-process-hash-mark-count 0)
|
|
|
1874 (make-variable-buffer-local 'efs-process-hash-mark-count)
|
|
|
1875
|
|
|
1876 (defvar efs-process-hash-mark-unit nil)
|
|
|
1877 (make-variable-buffer-local 'efs-process-hash-mark-unit)
|
|
|
1878
|
|
|
1879 (defvar efs-process-last-percent -1)
|
|
|
1880 (make-variable-buffer-local 'efs-process-last-percent)
|
|
|
1881
|
|
|
1882 (defvar efs-process-host nil)
|
|
|
1883 (make-variable-buffer-local 'efs-process-host)
|
|
|
1884
|
|
|
1885 (defvar efs-process-user nil)
|
|
|
1886 (make-variable-buffer-local 'efs-process-user)
|
|
|
1887
|
|
|
1888 (defvar efs-process-host-type nil)
|
|
|
1889 ;; Holds the host-type as a string, for showing it on the mode line.
|
|
|
1890 (make-variable-buffer-local 'efs-process-host-type)
|
|
|
1891
|
|
|
1892 (defvar efs-process-xfer-type nil)
|
|
|
1893 ;; Set to one of 'ascii, 'ebcdic, 'image, 'tenex, or nil to indicate
|
|
|
1894 ;; the current setting of the transfer type for the connection. nil means
|
|
|
1895 ;; that we don't know.
|
|
|
1896 (make-variable-buffer-local 'efs-process-xfer-type)
|
|
|
1897
|
|
|
1898 (defvar efs-process-client-altered-xfer-type nil)
|
|
|
1899 ;; Sometimes clients alter the xfer type, such as doing
|
|
|
1900 ;; an ls it is changed to ascii. If we are using quoted commands
|
|
|
1901 ;; to do xfers the client doesn't get a chance to set it back.
|
|
|
1902 (make-variable-buffer-local 'efs-process-client-altered-xfer-type)
|
|
|
1903
|
|
|
1904 (defvar efs-process-prompt-regexp nil)
|
|
|
1905 ;; local value of prompt of FTP client.
|
|
|
1906 (make-variable-buffer-local 'efs-process-prompt-regexp)
|
|
|
1907
|
|
|
1908 (defvar efs-process-cmd-counter 0)
|
|
|
1909 ;; Counts FTP commands, mod 16.
|
|
|
1910 (make-variable-buffer-local 'efs-process-cmd-counter)
|
|
|
1911
|
|
|
1912 ;;;; ------------------------------------------------------------
|
|
|
1913 ;;;; General Internal Variables.
|
|
|
1914 ;;;; ------------------------------------------------------------
|
|
|
1915
|
|
|
1916 ;;; For the byte compiler
|
|
|
1917 ;;
|
|
|
1918 ;; These variables are usually unbound. We are just notifying the
|
|
|
1919 ;; byte compiler that we know what we are doing.
|
|
|
1920
|
|
|
1921 (defvar bv-length) ; getting file versions.
|
|
|
1922 (defvar default-file-name-handler-alist) ; for file-name-handler-alist
|
|
|
1923 (defvar efs-completion-dir) ; for file name completion predicates
|
|
|
1924 (defvar dired-directory) ; for default actions in interactive specs
|
|
|
1925 (defvar dired-local-variables-file) ; for inhibiting child look ups
|
|
|
1926 (defvar dired-in-query) ; don't clobber dired queries with stat messages
|
|
|
1927 (defvar after-load-alist) ; in case we're in emacs 18.
|
|
|
1928 (defvar comint-last-input-start)
|
|
|
1929 (defvar comint-last-input-end)
|
|
|
1930 (defvar explicit-shell-file-name)
|
|
|
1931
|
|
|
1932 ;;; fluid vars
|
|
|
1933
|
|
|
1934 (defvar efs-allow-child-lookup t)
|
|
|
1935 ;; let-bind to nil, if want to inhibit child lookups.
|
|
|
1936
|
|
|
1937 (defvar efs-nested-cmd nil)
|
|
|
1938 ;; let-bound to t, when a cmd is executed by a cont or pre-cont.
|
|
|
1939 ;; Such cmds will never end by looking at the next item in the queue,
|
|
|
1940 ;; if they are run synchronously, but rely on their calling function
|
|
|
1941 ;; to do this.
|
|
|
1942
|
|
|
1943 ;;; polling ftp buffers
|
|
|
1944
|
|
|
1945 (defvar efs-ftp-buffer-poll-time 300
|
|
|
1946 "Period, in seconds, which efs will poll ftp buffers for activity.
|
|
|
1947 Used for expiring \(killing\) inactive ftp buffers.")
|
|
|
1948
|
|
|
1949 (defconst efs-ftp-buffer-alist nil)
|
|
|
1950 ;; alist of ftp buffers, and the total number of seconds that they
|
|
|
1951 ;; have been idle.
|
|
|
1952
|
|
|
1953 ;;; load extensions
|
|
|
1954
|
|
|
1955 (defvar efs-load-lisp-extensions '(".elc" ".el" "")
|
|
|
1956 "List of extensions to try when loading lisp files.")
|
|
|
1957
|
|
|
1958 ;;; mode-line
|
|
|
1959
|
|
|
1960 (defvar efs-mode-line-string "")
|
|
|
1961 ;; Stores the string that efs displays on the mode line.
|
|
|
1962
|
|
|
1963 ;;; data & temporary buffers
|
|
|
1964
|
|
|
1965 (defvar efs-data-buffer-name " *ftp data*")
|
|
|
1966 ;; Buffer name to hold directory listing data received from ftp process.
|
|
|
1967
|
|
|
1968 (defvar efs-data-buffer-name-2 " *ftp data-2*")
|
|
|
1969 ;; A second buffer name in which to hold directory listings.
|
|
|
1970 ;; Used for listings which are made during another directory listing.
|
|
|
1971
|
|
|
1972 ;;; process names
|
|
|
1973
|
|
|
1974 (defvar efs-ctime-process-name-format "*efs ctime %s*")
|
|
|
1975 ;; Passed to format with second arg the host name.
|
|
|
1976
|
|
|
1977 ;;; For temporary files.
|
|
|
1978
|
|
|
1979 ;; This is a list of symbols.
|
|
|
1980 (defconst efs-tmp-name-files ())
|
|
|
1981 ;; Here is where these symbols live:
|
|
|
1982 (defconst efs-tmp-name-obarray (make-vector 7 0))
|
|
|
1983 ;; We put our version of the emacs PID here:
|
|
|
1984 (defvar efs-pid nil)
|
|
|
1985
|
|
|
1986 ;;; For abort-recursive-edit
|
|
|
1987
|
|
|
1988 (defvar efs-abort-recursive-edit-data nil)
|
|
|
1989 (defvar efs-abort-recursive-edit-delay 5)
|
|
|
1990 ;; Number of seconds after which efs-abort-recursive-edit-and-then
|
|
|
1991 ;; will decide not to runs its sentinel. The assumption is that something
|
|
|
1992 ;; went wrong.
|
|
|
1993
|
|
|
1994 ;;; hashtables (Use defconst's to clobber any user silliness.)
|
|
|
1995
|
|
|
1996 (defconst efs-files-hashtable (efs-make-hashtable 97))
|
|
|
1997 ;; Hash table for storing directories and their respective files.
|
|
|
1998
|
|
|
1999 (defconst efs-expand-dir-hashtable (efs-make-hashtable))
|
|
|
2000 ;; Hash table of tilde expansions for remote directories.
|
|
|
2001
|
|
|
2002 (defconst efs-ls-converter-hashtable (efs-make-hashtable 37))
|
|
|
2003 ;; Hashtable for storing functions to convert listings from one
|
|
|
2004 ;; format to another. Keys are the required switches, and the values
|
|
|
2005 ;; are alist of the form ((SWITCHES . CONVERTER)...) where is SWITCHES
|
|
|
2006 ;; are the listing switches for the original listing, and CONVERTER is a
|
|
|
2007 ;; function of one-variable, the listing-type, to do the conversion
|
|
|
2008 ;; on data in the current buffer. SWITCHES is either a string, or nil.
|
|
|
2009 ;; nil means that the listing can be converted from cache in
|
|
|
2010 ;; efs-files-hashtable, a string from cache in efs-ls-cache. For the latter,
|
|
|
2011 ;; listings with no switches (dumb listings), represent SWITCHES as a string
|
|
|
2012 ;; consisting only of the ASCII null character.
|
|
|
2013
|
|
|
2014 ;;; cache variables (Use defconst's to clobber any user sillines.)
|
|
|
2015
|
|
|
2016 (defconst efs-ls-cache nil
|
|
|
2017 "List of results from efs-ls.
|
|
|
2018 Each entry is a list of four elements, the file listed, the switches used
|
|
|
2019 \(nil if none\), the listing string, and whether this string has already been
|
|
|
2020 parsed.")
|
|
|
2021
|
|
|
2022 (defvar efs-ls-uncache nil)
|
|
|
2023 ;; let-bind this to t, if you want to be sure that efs-ls will replace any
|
|
|
2024 ;; cache entries.
|
|
|
2025
|
|
|
2026 ;; This is a cache to see if the user has changed
|
|
|
2027 ;; completion-ignored-extensions.
|
|
|
2028 (defconst efs-completion-ignored-extensions completion-ignored-extensions
|
|
|
2029 "This variable is internal to efs. Do not set.
|
|
|
2030 See completion-ignored-extensions, instead.")
|
|
|
2031
|
|
|
2032 ;; We cache the regexp we use for completion-ignored-extensions. This
|
|
|
2033 ;; saves building a string every time we do completion. String construction
|
|
|
2034 ;; is costly in emacs.
|
|
|
2035 (defconst efs-completion-ignored-pattern
|
|
|
2036 (mapconcat (function
|
|
|
2037 (lambda (s) (if (stringp s)
|
|
|
2038 (concat (regexp-quote s) "$")
|
|
|
2039 "/"))) ; / never in filename
|
|
|
2040 efs-completion-ignored-extensions
|
|
|
2041 "\\|")
|
|
|
2042 "This variable is internal to efs. Do not set.
|
|
|
2043 See completion-ignored-extensions, instead.")
|
|
|
2044
|
|
|
2045 (defvar efs-system-fqdn nil
|
|
|
2046 "Cached value of the local systems' fully qualified domain name.")
|
|
|
2047
|
|
|
2048 ;;; The file-type-alist
|
|
|
2049
|
|
|
2050 ;; efs-file-type-alist is an alist indexed by host-type
|
|
|
2051 ;; which stores data on how files are structured on the given
|
|
|
2052 ;; host-type. Each entry is a list of three elements. The first is the
|
|
|
2053 ;; definition of a `byte', the second the native character representation,
|
|
|
2054 ;; and the third, the file structure.
|
|
|
2055 ;;
|
|
|
2056 ;; Meanings of the symbols:
|
|
|
2057 ;; ------------------------
|
|
|
2058 ;; The byte symbols:
|
|
|
2059 ;; 8-bit = bytes of 8-bits
|
|
|
2060 ;; 36-bit-wa = 36-bit word aligned. Precisely, the addressing unit is that
|
|
|
2061 ;; of a PDP-10 using the "<440700,,0> byte pointer".
|
|
|
2062 ;;
|
|
|
2063 ;; The native character set symbols:
|
|
|
2064 ;; 8-ascii = 8-bit NVT-ASCII
|
|
|
2065 ;; 7-ascii = 7-bit ascii as on a PDP-10
|
|
|
2066 ;; ebcdic = EBCDIC as on an IBM mainframe
|
|
|
2067 ;; lispm = the native character set on a lispm (Symbolics and LMI)
|
|
|
2068 ;; mts = native character representation in the Michigan Terminal System
|
|
|
2069 ;; (which runs on IBM and Amdal mainframes), similar to ebcdic
|
|
|
2070 ;;
|
|
|
2071 ;; The file structure symbols:
|
|
|
2072 ;;
|
|
|
2073 ;; file-nl = data is stored as a contiguous sequence of data bytes
|
|
|
2074 ;; with EOL denoted by <NL>.
|
|
|
2075 ;; file-crlf = data is stored as a contiguous sequence of data bytes
|
|
|
2076 ;; with EOL denoted by <CR-LF>
|
|
|
2077 ;; record = data is stored as a sequence of records
|
|
|
2078 ;; file-lispm = data as stored on a lispm. i.e. a sequence of bits
|
|
|
2079 ;; with EOL denoted by character code 138 (?)
|
|
|
2080 ;;
|
|
|
2081 ;; If we've messed anything up here, please let us know.
|
|
|
2082
|
|
|
2083 (defvar efs-file-type-alist
|
|
|
2084 '((unix . (8-bit 8-ascii file-nl))
|
|
|
2085 (sysV-unix . (8-bit 8-ascii file-nl))
|
|
|
2086 (bsd-unix . (8-bit 8-ascii file-nl))
|
|
|
2087 (apollo-unix . (8-bit 8-ascii file-nl))
|
|
|
2088 (dumb-apollo-unix . (8-bit 8-ascii file-nl))
|
|
|
2089 (dumb-unix . (8-bit 8-ascii file-nl))
|
|
|
2090 (super-dumb-unix . (8-bit 8-ascii file-nl))
|
|
|
2091 (guardian . (8-bit ascii file-nl))
|
|
|
2092 (plan9 . (8-bit 8-ascii file-nl))
|
|
|
2093 (dos . (8-bit 8-ascii file-crlf))
|
|
|
2094 (ms-unix . (8-bit 8-ascii file-crlf))
|
|
|
2095 (netware . (8-bit 8-ascii file-crlf))
|
|
|
2096 (os2 . (8-bit 8-ascii file-crlf))
|
|
|
2097 (tops-20 . (36-bit-wa 7-ascii file-crlf))
|
|
|
2098 (mpe . (8-bit 8-ascii record))
|
|
|
2099 (mvs . (8-bit ebcdic record))
|
|
|
2100 (cms . (8-bit ebcdic record))
|
|
|
2101 (cms-knet . (8-bit ebcdic record))
|
|
|
2102 (mts . (8-bit mts record)) ; mts seems to have its own char rep.
|
|
|
2103 ; Seems to be close to ebcdic, but not the same.
|
|
|
2104 (dos-distinct . (8-bit 8-ascii file-crlf))
|
|
|
2105 (ka9q . (8-bit 8-ascii file-crlf))
|
|
|
2106 (vms . (8-bit 8-ascii record)) ; The mysteries of VMS's RMS.
|
|
|
2107 (hell . (8-bit 8-ascii file-crlf))
|
|
|
2108 (vos . (8-bit 8-ascii record))
|
|
|
2109 (ti-explorer . (8-bit lispm file-lispm)) ; lispms use a file structure, but
|
|
|
2110 ; use an out of range char to
|
|
|
2111 ; indicate EOL.
|
|
|
2112 (ti-twenex . (8-bit lispm file-lispm))
|
|
|
2113 (nos-ve . (8-bit 8-ascii record))
|
|
|
2114 (coke . (8-bit 8-ascii file-nl)) ; only support 8-bit beverages
|
|
|
2115 (nil . (8-bit 8-ascii file-nl)))) ; the local host
|
|
|
2116
|
|
|
2117 ;;; Status messages
|
|
|
2118
|
|
|
2119 (defvar efs-last-message-time -86400) ; yesterday
|
|
|
2120 ;; The time of the last efs status message. c.f. efs-message-interval
|
|
|
2121
|
|
|
2122 ;;; For handling dir listings
|
|
|
2123
|
|
|
2124 ;; This MUST match all the way to to the start of the filename.
|
|
|
2125 ;; This version corresponds to what dired now uses (sandy, 14.1.93)
|
|
|
2126 (defvar efs-month-and-time-regexp
|
|
|
2127 (concat
|
|
|
2128 " \\([0-9]+\\) +" ; file size
|
|
|
2129 "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|June?\\|July?\\|Aug\\|Sep\\|Oct"
|
|
|
2130 ; June and July are for HP-UX 9.0
|
|
|
2131 "\\|Nov\\|Dec\\) \\([ 0-3][0-9]\\)\\("
|
|
|
2132 " [012][0-9]:[0-6][0-9] \\|" ; time
|
|
|
2133 " [12][90][0-9][0-9] \\|" ; year on IRIX, NeXT, SunOS, ULTRIX, Apollo
|
|
|
2134 ; HP-UX, A/UX
|
|
|
2135 " [12][90][0-9][0-9] \\)" ; year on AIX
|
|
|
2136 ))
|
|
|
2137
|
|
|
2138 (defvar efs-month-alist
|
|
|
2139 '(("Jan" . 1) ("Feb". 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6)
|
|
|
2140 ("June" . 6) ("Jul" . 7) ("July" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10)
|
|
|
2141 ("Nov" . 11) ("Dec" . 12)))
|
|
|
2142
|
|
|
2143 ;; Matches the file modes, link number, and owner string.
|
|
|
2144 ;; The +/- is for extended file access permissions.
|
|
|
2145 (defvar efs-modes-links-owner-regexp
|
|
|
2146 (concat
|
|
|
2147 "\\([^ ][-r][-w][^ ][-r][-w][^ ][-r][-w][^ ]\\)[-+]? *\\([0-9]+\\)"
|
|
|
2148 " +\\([^ ]+\\) "))
|
|
|
2149
|
|
|
2150 ;;;; ---------------------------------------------------------------
|
|
|
2151 ;;;; efs-dired variables
|
|
|
2152 ;;;; ---------------------------------------------------------------
|
|
|
2153
|
|
|
2154 ;; These variables must be here, instead of in efs-dired.el, because
|
|
|
2155 ;; the efs-HOST-TYPE.el files need to add to it.
|
|
|
2156 (defvar efs-dired-re-exe-alist nil
|
|
|
2157 "Association list of regexps which match file lines of executable files.")
|
|
|
2158
|
|
|
2159 (defvar efs-dired-re-dir-alist nil
|
|
|
2160 "Association list of regexps which match file lines of subdirectories.")
|
|
|
2161
|
|
|
2162 (defvar efs-dired-host-type nil
|
|
|
2163 "Host type of a dired buffer. \(buffer local\)")
|
|
|
2164 (make-variable-buffer-local 'efs-dired-host-type)
|
|
|
2165
|
|
|
2166 (defvar efs-dired-listing-type nil
|
|
|
2167 "Listing type of a dired buffer. \(buffer local\)")
|
|
|
2168 (make-variable-buffer-local 'efs-dired-listing-type)
|
|
|
2169
|
|
|
2170 (defvar efs-dired-listing-type-string nil)
|
|
|
2171 (make-variable-buffer-local 'efs-dired-listing-type-string)
|
|
|
2172
|
|
|
2173 ;;;; -------------------------------------------------------------
|
|
|
2174 ;;;; New error symbols.
|
|
|
2175 ;;;; -------------------------------------------------------------
|
|
|
2176
|
|
|
2177 (put 'ftp-error 'error-conditions '(ftp-error file-error error))
|
|
|
2178 ;; (put 'ftp-error 'error-message "FTP error")
|
|
|
2179
|
|
|
2180
|
|
|
2181 ;;;; =============================================================
|
|
|
2182 ;;;; >3
|
|
|
2183 ;;;; Utilities
|
|
|
2184 ;;;; =============================================================
|
|
|
2185
|
|
|
2186 ;;; -------------------------------------------------------------------
|
|
|
2187 ;;; General Macros (Make sure that macros are defined before they're
|
|
|
2188 ;;; used, for the byte compiler.
|
|
|
2189 ;;; -------------------------------------------------------------------
|
|
|
2190
|
|
|
2191 (defmacro efs-kbd-quit-protect (proc &rest body)
|
|
|
2192 ;; When an efs function controlling an FTP connection gets a kbd-quit
|
|
|
2193 ;; this tries to make sure that everything unwinds consistently.
|
|
|
2194 (let ((temp (make-symbol "continue")))
|
|
|
2195 (list 'let
|
|
|
2196 (list '(quit-flag nil)
|
|
|
2197 '(inhibit-quit nil)
|
|
|
2198 (list temp t))
|
|
|
2199 (list
|
|
|
2200 'while temp
|
|
|
2201 (list 'setq temp nil)
|
|
|
2202 (list
|
|
|
2203 'condition-case nil
|
|
|
2204 (cons 'progn
|
|
|
2205 body)
|
|
|
2206 (list 'quit
|
|
|
2207 (list 'setq temp
|
|
|
2208 (list 'efs-kbd-quit-protect-cover-quit proc))))))))
|
|
|
2209
|
|
|
2210 (defun efs-kbd-quit-protect-cover-quit (proc)
|
|
|
2211 ;; This function exists to keep the macro expansion of the
|
|
|
2212 ;; efs-kbd-quit-protect down to a reasonable size.
|
|
|
2213 (let ((pop-up-windows t)
|
|
|
2214 (buff (get-buffer (process-buffer proc)))
|
|
|
2215 res)
|
|
|
2216 (if (save-window-excursion
|
|
|
2217 (if buff
|
|
|
2218 (progn
|
|
|
2219 (pop-to-buffer buff)
|
|
|
2220 (goto-char (point-max))
|
|
|
2221 (recenter (- (window-height)
|
|
|
2222 2))))
|
|
|
2223 (setq res (efs-kill-ftp-buffer-with-prompt proc buff)))
|
|
|
2224 (progn
|
|
|
2225 (if (eq res 0)
|
|
|
2226 (if (eq (selected-window)
|
|
|
2227 (minibuffer-window))
|
|
|
2228 (efs-abort-recursive-edit-and-then
|
|
|
2229 (function
|
|
|
2230 (lambda (buff)
|
|
|
2231 (if (get-buffer buff)
|
|
|
2232 (display-buffer buff))))
|
|
|
2233 buff)
|
|
|
2234 (if (get-buffer buff)
|
|
|
2235 (display-buffer buff))
|
|
|
2236 (signal 'quit nil))
|
|
|
2237 (if (eq (selected-window) (minibuffer-window))
|
|
|
2238 (abort-recursive-edit)
|
|
|
2239 (signal (quote quit) nil)))
|
|
|
2240 nil)
|
|
|
2241 (sit-for 0)
|
|
|
2242 (message "Waiting on %s..." (or (car (efs-parse-proc-name proc))
|
|
|
2243 "a whim"))
|
|
|
2244 t)))
|
|
|
2245
|
|
|
2246 (put 'efs-kbd-quit-protect 'lisp-indent-hook 1)
|
|
|
2247
|
|
|
2248 (defmacro efs-save-buffer-excursion (&rest forms)
|
|
|
2249 "Execute FORMS, restoring the current buffer afterwards.
|
|
|
2250 Unlike, save-excursion, this does not restore the point."
|
|
|
2251 (let ((temp (make-symbol "saved-buff")))
|
|
|
2252 (list 'let
|
|
|
2253 (list (list temp '(current-buffer)))
|
|
|
2254 (list 'unwind-protect
|
|
|
2255 (cons 'progn forms)
|
|
|
2256 (list 'condition-case nil
|
|
|
2257 (list 'set-buffer temp)
|
|
|
2258 '(error nil))))))
|
|
|
2259
|
|
|
2260 (put 'efs-save-buffer-excursion 'lisp-indent-hook 0)
|
|
|
2261
|
|
|
2262 (defmacro efs-unquote-dollars (string)
|
|
|
2263 ;; Unquote $$'s to $'s in STRING.
|
|
|
2264 (` (let ((string (, string))
|
|
|
2265 (start 0)
|
|
|
2266 new)
|
|
|
2267 (while (string-match "\\$\\$" string start)
|
|
|
2268 (setq new (concat new (substring
|
|
|
2269 string start (1+ (match-beginning 0))))
|
|
|
2270 start (match-end 0)))
|
|
|
2271 (if new
|
|
|
2272 (concat new (substring string start))
|
|
|
2273 string))))
|
|
|
2274
|
|
|
2275 (defmacro efs-get-file-part (path)
|
|
|
2276 ;; Given PATH, return the file part used for looking up the file's entry
|
|
|
2277 ;; in a hashtable.
|
|
|
2278 ;; This need not be the same thing as file-name-nondirectory.
|
|
|
2279 (` (let ((file (file-name-nondirectory (, path))))
|
|
|
2280 (if (string-equal file "")
|
|
|
2281 "."
|
|
|
2282 file))))
|
|
|
2283
|
|
|
2284 (defmacro efs-ftp-path-macro (path)
|
|
|
2285 ;; Just a macro version of efs-ftp-path, for speed critical
|
|
|
2286 ;; situations. Could use (inline ...) instead, but not everybody
|
|
|
2287 ;; uses the V19 byte-compiler. Also, doesn't call efs-save-match-data,
|
|
|
2288 ;; but assumes that the calling function does it.
|
|
|
2289 (`
|
|
|
2290 (let ((path (, path)))
|
|
|
2291 (or (string-equal path efs-ftp-path-arg)
|
|
|
2292 (setq efs-ftp-path-res
|
|
|
2293 (and (string-match efs-path-regexp path)
|
|
|
2294 (let ((host (substring path (match-beginning 2)
|
|
|
2295 (match-end 2)))
|
|
|
2296 (user (and (match-beginning 1)
|
|
|
2297 (substring path (match-beginning 1)
|
|
|
2298 (1- (match-end 1)))))
|
|
|
2299 (rpath (substring path (1+ (match-end 2)))))
|
|
|
2300 (list (if (string-equal host "")
|
|
|
2301 (setq host (system-name))
|
|
|
2302 host)
|
|
|
2303 (or user (efs-get-user host))
|
|
|
2304 rpath)))
|
|
|
2305 ;; Set this last, in case efs-get-user calls this function,
|
|
|
2306 ;; which would modify an earlier setting.
|
|
|
2307 efs-ftp-path-arg path))
|
|
|
2308 efs-ftp-path-res)))
|
|
|
2309
|
|
|
2310 (defmacro efs-canonize-switches (switches)
|
|
|
2311 ;; Converts a switches string, into a lexographically ordered string,
|
|
|
2312 ;; omitting - and spaces. Should we remove duplicate characters too?
|
|
|
2313 (` (if (, switches)
|
|
|
2314 (mapconcat
|
|
|
2315 'char-to-string
|
|
|
2316 (sort (delq ?- (delq ?\ (mapcar 'identity (, switches)))) '<) "")
|
|
|
2317 ;; For the purpose of interning in a hashtable, represent the nil
|
|
|
2318 ;; switches, as a string consisting of the ascii null character.
|
|
|
2319 (char-to-string 0))))
|
|
|
2320
|
|
|
2321 (defmacro efs-canonize-file-name (fn)
|
|
|
2322 ;; Canonizes the case of file names.
|
|
|
2323 (` (let ((parsed (efs-ftp-path (, fn))))
|
|
|
2324 (if parsed
|
|
|
2325 (let ((host (car parsed)))
|
|
|
2326 (if (memq (efs-host-type host) efs-case-insensitive-host-types)
|
|
|
2327 (downcase (, fn))
|
|
|
2328 (format efs-path-format-string (nth 1 parsed) (downcase host)
|
|
|
2329 (nth 2 parsed))))
|
|
|
2330 (, fn)))))
|
|
|
2331
|
|
|
2332 (defmacro efs-get-files-hashtable-entry (fn)
|
|
|
2333 (` (efs-get-hash-entry (efs-canonize-file-name (, fn)) efs-files-hashtable)))
|
|
|
2334
|
|
|
2335 ;;;; ------------------------------------------------------------
|
|
|
2336 ;;;; Utility Functions
|
|
|
2337 ;;;; ------------------------------------------------------------
|
|
|
2338
|
|
|
2339 (defun efs-kill-ftp-buffer-with-prompt (proc buffer)
|
|
|
2340 ;; Does a 3-way prompt to kill a ftp PROC and BUFFER.
|
|
|
2341 ;; Returns t if buffer was killed, 0 if only process, nil otherwise.
|
|
|
2342 (let ((inhibit-quit t)
|
|
|
2343 (cursor-in-echo-area t)
|
|
|
2344 char)
|
|
|
2345 (message
|
|
|
2346 (if efs-debug-ftp-connection
|
|
|
2347 "Kill ftp process and buffer (y[es], n[o], c[lose], d[ebug] ) "
|
|
|
2348 "Kill ftp process and buffer? (y or n, c to only close process) "))
|
|
|
2349 (setq char (read-char))
|
|
|
2350 (prog1
|
|
|
2351 (cond
|
|
|
2352 ((memq char '(?y ?Y ?\ ))
|
|
|
2353 (set-process-sentinel proc nil)
|
|
|
2354 (condition-case nil
|
|
|
2355 (kill-buffer buffer)
|
|
|
2356 (error nil))
|
|
|
2357 t)
|
|
|
2358 ((memq char '(?c ?C))
|
|
|
2359 (set-process-sentinel proc nil)
|
|
|
2360 (condition-case nil
|
|
|
2361 (save-excursion
|
|
|
2362 (set-buffer buffer)
|
|
|
2363 (setq efs-process-busy nil
|
|
|
2364 efs-process-q nil)
|
|
|
2365 (delete-process proc))
|
|
|
2366 (error nil))
|
|
|
2367 0)
|
|
|
2368 ((memq char '(?n ?N))
|
|
|
2369 (message "")
|
|
|
2370 nil)
|
|
|
2371 ((and efs-debug-ftp-connection
|
|
|
2372 (memq char '(?d ?D)))
|
|
|
2373 (condition-case nil
|
|
|
2374 (save-excursion
|
|
|
2375 (set-buffer buffer)
|
|
|
2376 (setq efs-process-busy nil
|
|
|
2377 efs-process-q nil))
|
|
|
2378 (error nil))
|
|
|
2379 0)
|
|
|
2380 (t
|
|
|
2381 (message
|
|
|
2382 (if efs-debug-ftp-connection
|
|
|
2383 "Type one of y, n, c or d."
|
|
|
2384 "Type one of y, n or c."))
|
|
|
2385 (ding)
|
|
|
2386 (sit-for 1)
|
|
|
2387 (setq quit-flag nil)
|
|
|
2388 (efs-kill-ftp-buffer-with-prompt proc buffer))))))
|
|
|
2389
|
|
|
2390 (defun efs-barf-if-not-directory (directory)
|
|
|
2391 ;; Signal an error if DIRECTORY is not one.
|
|
|
2392 (or (file-directory-p directory)
|
|
|
2393 (signal 'file-error
|
|
|
2394 (list "Opening directory"
|
|
|
2395 (if (file-exists-p directory)
|
|
|
2396 "not a directory"
|
|
|
2397 "no such file or directory")
|
|
|
2398 directory))))
|
|
|
2399
|
|
|
2400 (defun efs-call-cont (cont &rest args)
|
|
|
2401 "Call the function specified by CONT.
|
|
|
2402 CONT can be either a function or a list of a function and some args.
|
|
|
2403 The first parameters passed to the function will be ARGS. The remaining
|
|
|
2404 args will be taken from CONT if a list was passed."
|
|
|
2405 (if cont
|
|
|
2406 (let ((efs-nested-cmd t)) ; let-bound so that conts don't pop any queues
|
|
|
2407 (efs-save-buffer-excursion
|
|
|
2408 (if (and (listp cont)
|
|
|
2409 (not (eq (car cont) 'lambda)))
|
|
|
2410 (apply (car cont) (append args (cdr cont)))
|
|
|
2411 (apply cont args))))))
|
|
|
2412
|
|
|
2413 (defun efs-replace-path-component (fullpath path)
|
|
|
2414 "For FULLPATH matching efs-path-regexp replace the path component with PATH."
|
|
|
2415 (efs-save-match-data
|
|
|
2416 (if (string-match efs-path-root-regexp fullpath)
|
|
|
2417 (concat (substring fullpath 0 (match-end 0)) path)
|
|
|
2418 path)))
|
|
|
2419
|
|
|
2420 (defun efs-abort-recursive-edit-and-then (fun &rest args)
|
|
|
2421 ;; Does an abort-recursive-edit, and runs fun _after_ emacs returns to
|
|
|
2422 ;; top level.
|
|
|
2423 (if (get-process "efs-abort-recursive-edit")
|
|
|
2424 ;; Don't queue these things. Clean them out.
|
|
|
2425 (delete-process "efs-abort-recursive-edit"))
|
|
|
2426 (or efs-suppress-abort-recursive-edit-and-then
|
|
|
2427 (progn
|
|
|
2428 (setq efs-abort-recursive-edit-data (cons (nth 1 (current-time))
|
|
|
2429 (cons fun args)))
|
|
|
2430 (condition-case nil
|
|
|
2431 (set-process-sentinel
|
|
|
2432 (let ((default-directory exec-directory)
|
|
|
2433 (process-connection-type nil))
|
|
|
2434 (start-process "efs-abort-recursive-edit" nil "sleep" "0"))
|
|
|
2435 (function
|
|
|
2436 (lambda (proc string)
|
|
|
2437 (let ((data efs-abort-recursive-edit-data))
|
|
|
2438 (setq efs-abort-recursive-edit-data)
|
|
|
2439 (if (and data
|
|
|
2440 (integerp (car data))
|
|
|
2441 (<= (- (nth 1 (current-time)) (car data))
|
|
|
2442 efs-abort-recursive-edit-delay))
|
|
|
2443 (apply (nth 1 data) (nthcdr 2 data)))))))
|
|
|
2444 (error nil))))
|
|
|
2445 (abort-recursive-edit))
|
|
|
2446
|
|
|
2447 (defun efs-occur-in-string (char string)
|
|
|
2448 ;; Return the number of occurrences of CHAR in STRING.
|
|
|
2449 (efs-save-match-data
|
|
|
2450 (let ((regexp (regexp-quote (char-to-string char)))
|
|
|
2451 (count 0)
|
|
|
2452 (start 0))
|
|
|
2453 (while (string-match regexp string start)
|
|
|
2454 (setq start (match-end 0)
|
|
|
2455 count (1+ count)))
|
|
|
2456 count)))
|
|
|
2457
|
|
|
2458 (defun efs-parse-proc-name (proc)
|
|
|
2459 ;; Parses the name of process to return a list \(host user\).
|
|
|
2460 (efs-save-match-data
|
|
|
2461 (let ((name (process-name proc)))
|
|
|
2462 (and name
|
|
|
2463 (string-match "^\\*ftp \\([^@]*\\)@\\([^*]+\\)\\*$" name)
|
|
|
2464 (list (substring name (match-beginning 2) (match-end 2))
|
|
|
2465 (substring name (match-beginning 1) (match-end 1)))))))
|
|
|
2466
|
|
|
2467 ;;;; ------------------------------------------------------------
|
|
|
2468 ;;;; Of Geography, connectivity, and the internet... Gateways.
|
|
|
2469 ;;;; ------------------------------------------------------------
|
|
|
2470
|
|
|
2471 (defun efs-use-gateway-p (host &optional opaque-p)
|
|
|
2472 ;; Returns whether to access this host via a gateway.
|
|
|
2473 ;; Returns the gateway type as a symbol. See efs-gateway-type <V>.
|
|
|
2474 ;; If optional OPAQUE-P is non-nil, only returns non-nil if the gateway
|
|
|
2475 ;; type is in the list efs-opaque-gateways <V>.
|
|
|
2476 (and efs-gateway-type
|
|
|
2477 host ;local host is nil
|
|
|
2478 (efs-save-match-data
|
|
|
2479 (and (not (string-match efs-ftp-local-host-regexp host))
|
|
|
2480 (let ((type (car efs-gateway-type)))
|
|
|
2481 (if opaque-p
|
|
|
2482 (and (memq type efs-opaque-gateways) type)
|
|
|
2483 type))))))
|
|
|
2484
|
|
|
2485 (defun efs-local-to-gateway-filename (filename &optional reverse)
|
|
|
2486 ;; Converts a FILENAME on the local host to its name on the gateway,
|
|
|
2487 ;; using efs-gateway-mounted-dirs-alist. If REVERSE is non-nil, does just
|
|
|
2488 ;; that. If the there is no corresponding name because non of its parent
|
|
|
2489 ;; directories are mounted, returns nil.
|
|
|
2490 (if efs-gateway-mounted-dirs-alist
|
|
|
2491 (let ((len (length filename))
|
|
|
2492 (alist efs-gateway-mounted-dirs-alist)
|
|
|
2493 result elt elt-len)
|
|
|
2494 (if reverse
|
|
|
2495 (while (setq elt (car alist))
|
|
|
2496 (if (and (>= len (setq elt-len (length (cdr elt))))
|
|
|
2497 (string-equal (cdr elt) (substring filename 0 elt-len)))
|
|
|
2498 (setq result (concat (car elt)
|
|
|
2499 (substring filename elt-len))
|
|
|
2500 alist nil)
|
|
|
2501 (setq alist (cdr alist))))
|
|
|
2502 (while (setq elt (car alist))
|
|
|
2503 (if (and (>= len (setq elt-len (length (car elt))))
|
|
|
2504 (string-equal (car elt) (substring filename 0 elt-len)))
|
|
|
2505 (setq result (concat (cdr elt)
|
|
|
2506 (substring filename elt-len))
|
|
|
2507 alist nil)
|
|
|
2508 (setq alist (cdr alist)))))
|
|
|
2509 result)))
|
|
|
2510
|
|
|
2511 ;;; ------------------------------------------------------------
|
|
|
2512 ;;; Enhanced message support.
|
|
|
2513 ;;; ------------------------------------------------------------
|
|
|
2514
|
|
|
2515 (defun efs-message (fmt &rest args)
|
|
|
2516 "Output the given message, truncating to the size of the minibuffer window."
|
|
|
2517 (let ((msg (apply (function format) fmt args))
|
|
|
2518 (max (window-width (minibuffer-window))))
|
|
|
2519 (if (>= (length msg) max)
|
|
|
2520 (setq msg (concat "> " (substring msg (- 3 max)))))
|
|
|
2521 (message "%s" msg)))
|
|
|
2522
|
|
|
2523 (defun efs-message-p ()
|
|
|
2524 ;; Returns t, if efs is allowed to display a status message.
|
|
|
2525 (not
|
|
|
2526 (or (and (boundp 'dired-in-query) dired-in-query)
|
|
|
2527 (boundp 'search-message)
|
|
|
2528 cursor-in-echo-area
|
|
|
2529 (and (/= efs-message-interval 0)
|
|
|
2530 (let ((diff (- efs-last-message-time
|
|
|
2531 (setq efs-last-message-time
|
|
|
2532 (nth 1 (current-time))))))
|
|
|
2533 (and
|
|
|
2534 (> diff (- efs-message-interval))
|
|
|
2535 (< diff 0))))))) ; in case the clock wraps.
|
|
|
2536
|
|
|
2537 (efs-define-fun efs-relativize-filename (file &optional dir new)
|
|
|
2538 "Abbreviate the given filename relative to DIR .
|
|
|
2539 If DIR is nil, use the value of `default-directory' for the currently selected
|
|
|
2540 window. If the optional parameter NEW is given and the
|
|
|
2541 non-directory parts match, only return the directory part of the file."
|
|
|
2542 (let* ((dir (or dir (save-excursion
|
|
|
2543 (set-buffer (window-buffer (selected-window)))
|
|
|
2544 default-directory)))
|
|
|
2545 (dlen (length dir))
|
|
|
2546 (result file))
|
|
|
2547 (and (> (length file) dlen)
|
|
|
2548 (string-equal (substring file 0 dlen) dir)
|
|
|
2549 (setq result (substring file dlen)))
|
|
|
2550 (and new
|
|
|
2551 (string-equal (file-name-nondirectory result)
|
|
|
2552 (file-name-nondirectory new))
|
|
|
2553 (or (setq result (file-name-directory result))
|
|
|
2554 (setq result "./")))
|
|
|
2555 (abbreviate-file-name result)))
|
|
|
2556
|
|
|
2557 ;;; ------------------------------------------------------------
|
|
|
2558 ;;; Temporary file location and deletion...
|
|
|
2559 ;;; ------------------------------------------------------------
|
|
|
2560
|
|
|
2561 (defun efs-get-pid ()
|
|
|
2562 ;; Half-hearted attempt to get the current process's id.
|
|
|
2563 (setq efs-pid (substring (make-temp-name "") 1)))
|
|
|
2564
|
|
|
2565 (defun efs-make-tmp-name (host1 host2)
|
|
|
2566 ;; Returns the name of a new temp file, for moving data between HOST1
|
|
|
2567 ;; and HOST2. This temp file must be directly accessible to the
|
|
|
2568 ;; FTP client connected to HOST1. Using nil for either HOST1 or
|
|
|
2569 ;; HOST2 means the local host. The return value is actually a list
|
|
|
2570 ;; whose car is the name of the temp file wrto to the local host
|
|
|
2571 ;; and whose cdr is the name of the temp file wrto to the host
|
|
|
2572 ;; on which the client connected to HOST1 is running. If the gateway
|
|
|
2573 ;; is only accessible by FTP, then the car of this may be in efs extended
|
|
|
2574 ;; file name syntax.
|
|
|
2575 (let ((pid (or efs-pid (efs-get-pid)))
|
|
|
2576 (start ?a)
|
|
|
2577 file entry template rem-template template-len)
|
|
|
2578 ;; Compute the templates.
|
|
|
2579 (if (null (and host1 (efs-use-gateway-p host1 t)))
|
|
|
2580 ;; file must be local
|
|
|
2581 (if (null (and host2 (efs-use-gateway-p host2 t)))
|
|
|
2582 (setq template efs-tmp-name-template)
|
|
|
2583 (setq template (or (efs-local-to-gateway-filename
|
|
|
2584 efs-gateway-tmp-name-template t)
|
|
|
2585 efs-tmp-name-template)))
|
|
|
2586 ;; file must be on the gateway -- make sure that the gateway
|
|
|
2587 ;; configuration is sensible.
|
|
|
2588 (efs-save-match-data
|
|
|
2589 (or (string-match efs-ftp-local-host-regexp efs-gateway-host)
|
|
|
2590 (error "Gateway %s must be directly ftp accessible."
|
|
|
2591 efs-gateway-host)))
|
|
|
2592 (setq rem-template efs-gateway-tmp-name-template
|
|
|
2593 template (or (efs-local-to-gateway-filename
|
|
|
2594 efs-gateway-tmp-name-template t)
|
|
|
2595 (format efs-path-format-string
|
|
|
2596 (efs-get-user efs-gateway-host)
|
|
|
2597 efs-gateway-host
|
|
|
2598 efs-gateway-tmp-name-template))
|
|
|
2599 template-len (length template)))
|
|
|
2600 ;; Compute a new file name.
|
|
|
2601 (while (let (efs-verbose)
|
|
|
2602 (setq file (format "%s%c%s" template start pid)
|
|
|
2603 entry (intern file efs-tmp-name-obarray))
|
|
|
2604 (or (memq entry efs-tmp-name-files)
|
|
|
2605 (file-exists-p file)))
|
|
|
2606 (if (> (setq start (1+ start)) ?z)
|
|
|
2607 (progn
|
|
|
2608 (setq template (concat template "X"))
|
|
|
2609 (setq start ?a))))
|
|
|
2610 (setq efs-tmp-name-files
|
|
|
2611 (cons entry efs-tmp-name-files))
|
|
|
2612 (if rem-template
|
|
|
2613 (cons file (concat rem-template (substring file template-len)))
|
|
|
2614 (cons file file))))
|
|
|
2615
|
|
|
2616 (defun efs-del-tmp-name (temp)
|
|
|
2617 ;; Deletes file TEMP, a string.
|
|
|
2618 (setq efs-tmp-name-files
|
|
|
2619 (delq (intern temp efs-tmp-name-obarray)
|
|
|
2620 efs-tmp-name-files))
|
|
|
2621 (condition-case ()
|
|
|
2622 (let (efs-verbose)
|
|
|
2623 (delete-file temp))
|
|
|
2624 (error nil)))
|
|
|
2625
|
|
|
2626
|
|
|
2627 ;;;; ==============================================================
|
|
|
2628 ;;;; >4
|
|
|
2629 ;;;; Hosts, Users, Accounts, and Passwords
|
|
|
2630 ;;;; ==============================================================
|
|
|
2631 ;;;
|
|
|
2632 ;;; A lot of the support for this type of thing is in efs-netrc.el.
|
|
|
2633
|
|
|
2634 ;;;; ------------------------------------------------------------
|
|
|
2635 ;;;; Password support.
|
|
|
2636 ;;;; ------------------------------------------------------------
|
|
|
2637
|
|
|
2638 (defun efs-lookup-passwd (host user)
|
|
|
2639 ;; Look up the password for HOST and USER.
|
|
|
2640 (let ((ent (efs-get-host-user-property host user 'passwd)))
|
|
|
2641 (and ent (efs-code-string ent))))
|
|
|
2642
|
|
|
2643 (defun efs-system-fqdn ()
|
|
|
2644 "Returns a fully qualified domain name for the current host, if possible."
|
|
|
2645 (or efs-system-fqdn
|
|
|
2646 (setq efs-system-fqdn
|
|
|
2647 (let ((sys (system-name)))
|
|
|
2648 (if (string-match "\\." sys)
|
|
|
2649 sys
|
|
|
2650 (if efs-nslookup-program
|
|
|
2651 (let ((proc (let ((default-directory exec-directory)
|
|
|
2652 (process-connection-type nil))
|
|
|
2653 (start-process " *nslookup*" " *nslookup*"
|
|
|
2654 efs-nslookup-program sys)))
|
|
|
2655 (res sys)
|
|
|
2656 (n 0))
|
|
|
2657 (process-kill-without-query proc)
|
|
|
2658 (save-excursion
|
|
|
2659 (set-buffer (process-buffer proc))
|
|
|
2660 (let ((quit-flag nil)
|
|
|
2661 (inhibit-quit nil))
|
|
|
2662 (if efs-nslookup-threshold
|
|
|
2663 (progn
|
|
|
2664 (while (and (memq (process-status proc)
|
|
|
2665 '(run open))
|
|
|
2666 (< n efs-nslookup-threshold))
|
|
|
2667 (accept-process-output)
|
|
|
2668 (setq n (1+ n)))
|
|
|
2669 (if (>= n efs-nslookup-threshold)
|
|
|
2670 (progn
|
|
|
2671 (with-output-to-temp-buffer "*Help*"
|
|
|
2672 (princ (format "\
|
|
|
2673 efs is unable to determine a fully qualified domain name
|
|
|
2674 for the local host to send as an anonymous ftp password.
|
|
|
2675
|
|
|
2676 The function `system-name' is not returning a fully qualified
|
|
|
2677 domain name. An attempt to obtain a fully qualified domain name
|
|
|
2678 with `efs-nslookup-program' (currently set to \"%s\") has
|
|
|
2679 elicited no response from that program. Consider setting
|
|
|
2680 `efs-generate-anonymous-password' to an email address for anonymous
|
|
|
2681 ftp passwords.
|
|
|
2682
|
|
|
2683 For more information see the documentation (use C-h v) for the
|
|
|
2684 variables `efs-nslookup-program' and `efs-nslookup-threshold'."
|
|
|
2685 efs-nslookup-program)))
|
|
|
2686 (error "No response from %s"
|
|
|
2687 efs-nslookup-program))))
|
|
|
2688 (while (memq (process-status proc) '(run open))
|
|
|
2689 (accept-process-output proc)))
|
|
|
2690 (goto-char (point-min))
|
|
|
2691 (if (re-search-forward
|
|
|
2692 (format "^Name: *\\(%s\\.[^ \n\t]+\\)"
|
|
|
2693 sys) nil t)
|
|
|
2694 (setq res (buffer-substring
|
|
|
2695 (match-beginning 1)
|
|
|
2696 (match-end 1)))
|
|
|
2697 (kill-buffer (current-buffer)))))
|
|
|
2698 res)
|
|
|
2699 sys))))))
|
|
|
2700
|
|
|
2701 (defun efs-passwd-unique-list (alist)
|
|
|
2702 ;; Preserving the relative order of ALIST, remove all entries with duplicate
|
|
|
2703 ;; cars.
|
|
|
2704 (let (result)
|
|
|
2705 (while alist
|
|
|
2706 (or (assoc (car alist) result)
|
|
|
2707 (setq result (cons (car alist) result)))
|
|
|
2708 (setq alist (cdr alist)))
|
|
|
2709 (nreverse result)))
|
|
|
2710
|
|
|
2711 (defun efs-get-passwd-list (user host)
|
|
|
2712 ;; Returns an alist of the form '((pass host user) ...).
|
|
|
2713 ;; The order is essentially arbitrary, except that entries with user
|
|
|
2714 ;; equal to USER will appear first. Followed by entries with host equal to
|
|
|
2715 ;; HOST. Also, there will be no entries with duplicate values of pass.
|
|
|
2716 (efs-parse-netrc)
|
|
|
2717 (let* ((user-template (concat "/" user))
|
|
|
2718 (ulen (length user-template))
|
|
|
2719 (hlen (length host))
|
|
|
2720 primaries secondaries tertiaries)
|
|
|
2721 (efs-save-match-data
|
|
|
2722 (efs-map-hashtable
|
|
|
2723 (function
|
|
|
2724 (lambda (key passwd)
|
|
|
2725 (cond ((null passwd) nil)
|
|
|
2726 ((and (> (length key) ulen)
|
|
|
2727 (string-equal user-template
|
|
|
2728 (substring key (- ulen))))
|
|
|
2729 (setq primaries (cons (list (efs-code-string passwd)
|
|
|
2730 (substring key 0 (- ulen))
|
|
|
2731 (substring user-template 1))
|
|
|
2732 primaries)))
|
|
|
2733 ((and (> (length key) hlen)
|
|
|
2734 (string-equal host (substring key 0 hlen))
|
|
|
2735 (memq (aref key hlen) '(?/ ?.)))
|
|
|
2736 (if (string-match "/" key hlen)
|
|
|
2737 (setq secondaries
|
|
|
2738 (cons (list (efs-code-string passwd)
|
|
|
2739 (substring key 0 (match-beginning 0))
|
|
|
2740 (substring key (match-end 0)))
|
|
|
2741 secondaries))))
|
|
|
2742 ((string-match "/" key)
|
|
|
2743 (setq tertiaries
|
|
|
2744 (cons (list (efs-code-string passwd)
|
|
|
2745 (substring key 0 (match-beginning 0))
|
|
|
2746 (substring key (match-end 0)))
|
|
|
2747 tertiaries))))))
|
|
|
2748 efs-host-user-hashtable 'passwd))
|
|
|
2749 (efs-passwd-unique-list (nconc primaries secondaries tertiaries))))
|
|
|
2750
|
|
|
2751 (defun efs-get-passwd (host user)
|
|
|
2752 "Given a HOST and USER, return the FTP password, prompting if it was not
|
|
|
2753 previously set."
|
|
|
2754 (efs-parse-netrc)
|
|
|
2755
|
|
|
2756 ;; look up password in the hash table first; user might have overriden the
|
|
|
2757 ;; defaults.
|
|
|
2758 (cond ((efs-lookup-passwd host user))
|
|
|
2759
|
|
|
2760 ;; see if default user and password set from the .netrc file.
|
|
|
2761 ((and (stringp efs-default-user)
|
|
|
2762 efs-default-password
|
|
|
2763 (string-equal user efs-default-user))
|
|
|
2764 (copy-sequence efs-default-password))
|
|
|
2765
|
|
|
2766 ;; anonymous ftp password is handled specially since there is an
|
|
|
2767 ;; unwritten rule about how that is used on the Internet.
|
|
|
2768 ((and (efs-anonymous-p user)
|
|
|
2769 efs-generate-anonymous-password)
|
|
|
2770 (if (stringp efs-generate-anonymous-password)
|
|
|
2771 (copy-sequence efs-generate-anonymous-password)
|
|
|
2772 (concat (user-login-name) "@" (efs-system-fqdn))))
|
|
|
2773
|
|
|
2774 ;; see if same user has logged in to other hosts; if so then prompt
|
|
|
2775 ;; with the password that was used there.
|
|
|
2776 (t
|
|
|
2777 (let (others defaults passwd)
|
|
|
2778 (unwind-protect
|
|
|
2779 (progn
|
|
|
2780 (setq others (efs-get-passwd-list user host)
|
|
|
2781 defaults (mapcar
|
|
|
2782 (function
|
|
|
2783 (lambda (x)
|
|
|
2784 (cons
|
|
|
2785 (format
|
|
|
2786 "Passwd for %s@%s (same as %s@%s): "
|
|
|
2787 user host (nth 2 x) (nth 1 x))
|
|
|
2788 (car x))))
|
|
|
2789 others))
|
|
|
2790 (setq passwd
|
|
|
2791 (read-passwd
|
|
|
2792 (or defaults
|
|
|
2793 (format "Password for %s@%s: " user host)))))
|
|
|
2794 (while others
|
|
|
2795 (fillarray (car (car others)) 0)
|
|
|
2796 (setq others (cdr others))))
|
|
|
2797 (or (null passwd)
|
|
|
2798 (and efs-high-security-hosts
|
|
|
2799 (efs-save-match-data
|
|
|
2800 (string-match efs-high-security-hosts
|
|
|
2801 (format "%s@%s" user host))))
|
|
|
2802 (efs-set-passwd host user passwd))
|
|
|
2803 passwd))))
|
|
|
2804
|
|
|
2805 ;;;; ------------------------------------------------------------
|
|
|
2806 ;;;; Account support
|
|
|
2807 ;;;; ------------------------------------------------------------
|
|
|
2808
|
|
|
2809 (defun efs-get-account (host user &optional minidisk really)
|
|
|
2810 "Given a HOST, USER, and optional MINIDISK return the FTP account password.
|
|
|
2811 If the optional REALLY argument is given, prompts the user if it can't find
|
|
|
2812 one."
|
|
|
2813 (efs-parse-netrc)
|
|
|
2814 (let ((account (if minidisk
|
|
|
2815 (efs-get-hash-entry
|
|
|
2816 (concat (downcase host) "/" user "/" minidisk)
|
|
|
2817 efs-minidisk-hashtable
|
|
|
2818 (memq (efs-host-type host)
|
|
|
2819 efs-case-insensitive-host-types))
|
|
|
2820 (efs-get-host-user-property host user 'account))))
|
|
|
2821 (if account
|
|
|
2822 (efs-code-string account)
|
|
|
2823 ;; Do we really want to send the default-account passwd for all
|
|
|
2824 ;; minidisks?
|
|
|
2825 (if (and (stringp efs-default-user)
|
|
|
2826 (string-equal user efs-default-user)
|
|
|
2827 efs-default-account)
|
|
|
2828 efs-default-account
|
|
|
2829 (and really
|
|
|
2830 (let ((acct
|
|
|
2831 (read-passwd
|
|
|
2832 (if minidisk
|
|
|
2833 (format
|
|
|
2834 "Write access password for minidisk %s on %s@%s: "
|
|
|
2835 minidisk user host)
|
|
|
2836 (format
|
|
|
2837 "Account password for %s@%s: " user host)))))
|
|
|
2838 (or (and efs-high-security-hosts
|
|
|
2839 (efs-save-match-data
|
|
|
2840 efs-high-security-hosts
|
|
|
2841 (format "%s@%s" user host)))
|
|
|
2842 (efs-set-account host user minidisk acct))
|
|
|
2843 acct))))))
|
|
|
2844
|
|
|
2845 ;;;; -------------------------------------------------------------
|
|
|
2846 ;;;; Special classes of users.
|
|
|
2847 ;;;; -------------------------------------------------------------
|
|
|
2848
|
|
|
2849 (defun efs-anonymous-p (user)
|
|
|
2850 ;; Returns t if USER should be treated as an anonymous FTP login.
|
|
|
2851 (let ((user (downcase user)))
|
|
|
2852 (or (string-equal user "anonymous") (string-equal user "ftp"))))
|
|
|
2853
|
|
|
2854
|
|
|
2855 ;;;; =============================================================
|
|
|
2856 ;;;; >5
|
|
|
2857 ;;;; FTP client process, and server responses
|
|
|
2858 ;;;; =============================================================
|
|
|
2859
|
|
|
2860 ;;;; ---------------------------------------------------------
|
|
|
2861 ;;;; Support for asynch process queues.
|
|
|
2862 ;;;; ---------------------------------------------------------
|
|
|
2863
|
|
|
2864 (defun efs-add-to-queue (host user item)
|
|
|
2865 "To the end of the command queue for HOST and USER, adds ITEM.
|
|
|
2866 Does nothing if there is no process buffer for HOST and USER."
|
|
|
2867 (let ((buff (efs-ftp-process-buffer host user)))
|
|
|
2868 (if (get-buffer buff)
|
|
|
2869 (save-excursion
|
|
|
2870 (set-buffer buff)
|
|
|
2871 (setq efs-process-q
|
|
|
2872 (nconc efs-process-q (list item)))))))
|
|
|
2873
|
|
|
2874 ;;;; -------------------------------------------------------
|
|
|
2875 ;;;; Error recovery for the process filter.
|
|
|
2876 ;;;; -------------------------------------------------------
|
|
|
2877
|
|
|
2878 ;;; Could make this better, but it's such an unlikely error to hit.
|
|
|
2879 (defun efs-process-scream-and-yell (line)
|
|
|
2880 (let* ((buff (buffer-name (current-buffer)))
|
|
|
2881 (host (and (string-match "@\\(.*\\)\\*$" buff)
|
|
|
2882 (substring buff (match-beginning 1) (match-end 1)))))
|
|
|
2883 (with-output-to-temp-buffer "*Help*"
|
|
|
2884 (princ
|
|
|
2885 (concat
|
|
|
2886 "efs is unable to identify the following reply code
|
|
|
2887 from the ftp server " host ":\n\n" line "
|
|
|
2888
|
|
|
2889 Please send a bug report to ange@hplb.hpl.hp.com.
|
|
|
2890 In your report include a transcript of your\n"
|
|
|
2891 buff " buffer."))))
|
|
|
2892 (error "Unable to identify server code."))
|
|
|
2893
|
|
|
2894 (defun efs-error (host user msg)
|
|
|
2895 "Signal \'ftp-error for the FTP connection for HOST and USER.
|
|
|
2896 The error gives the string MSG as text. The process buffer for the FTP
|
|
|
2897 is popped up in another window."
|
|
|
2898 (let ((cur (selected-window))
|
|
|
2899 (pop-up-windows t)
|
|
|
2900 (buff (get-buffer (efs-ftp-process-buffer host user))))
|
|
|
2901 (if buff
|
|
|
2902 (progn
|
|
|
2903 (pop-to-buffer buff)
|
|
|
2904 (goto-char (point-max))
|
|
|
2905 (select-window cur))))
|
|
|
2906 (signal 'ftp-error (list (format "FTP Error: %s" msg))))
|
|
|
2907
|
|
|
2908 ;;;; --------------------------------------------------------------------
|
|
|
2909 ;;;; Process filter and supporting functions for handling FTP codes.
|
|
|
2910 ;;;; --------------------------------------------------------------------
|
|
|
2911
|
|
|
2912 (defun efs-process-handle-line (line proc)
|
|
|
2913 ;; Look at the given LINE from the ftp process PROC and try to catagorize it.
|
|
|
2914 (cond ((string-match efs-xfer-size-msgs line)
|
|
|
2915 (let ((n 1))
|
|
|
2916 ;; this loop will bomb with an args out of range error at 10
|
|
|
2917 (while (not (match-beginning n))
|
|
|
2918 (setq n (1+ n)))
|
|
|
2919 (setq efs-process-xfer-size
|
|
|
2920 (ash (string-to-int (substring line
|
|
|
2921 (match-beginning n)
|
|
|
2922 (match-end n)))
|
|
|
2923 -10))))
|
|
|
2924
|
|
|
2925 ((string-match efs-multi-msgs line)
|
|
|
2926 (setq efs-process-result-cont-lines
|
|
|
2927 (concat efs-process-result-cont-lines line "\n")))
|
|
|
2928
|
|
|
2929 ((string-match efs-skip-msgs line))
|
|
|
2930
|
|
|
2931 ((string-match efs-cmd-ok-msgs line)
|
|
|
2932 (if (string-match efs-cmd-ok-cmds efs-process-cmd)
|
|
|
2933 (setq efs-process-busy nil
|
|
|
2934 efs-process-result nil
|
|
|
2935 efs-process-result-line line)))
|
|
|
2936
|
|
|
2937 ((string-match efs-pending-msgs line)
|
|
|
2938 (if (string-match "^quote rnfr " efs-process-cmd)
|
|
|
2939 (setq efs-process-busy nil
|
|
|
2940 efs-process-result nil
|
|
|
2941 efs-process-result-line line)))
|
|
|
2942
|
|
|
2943 ((string-match efs-bytes-received-msgs line)
|
|
|
2944 (if efs-process-server-confused
|
|
|
2945 (setq efs-process-busy nil
|
|
|
2946 efs-process-result nil
|
|
|
2947 efs-process-result-line line)))
|
|
|
2948
|
|
|
2949 ((string-match efs-server-confused-msgs line)
|
|
|
2950 (setq efs-process-server-confused t))
|
|
|
2951
|
|
|
2952 ((string-match efs-good-msgs line)
|
|
|
2953 (setq efs-process-busy nil
|
|
|
2954 efs-process-result nil
|
|
|
2955 efs-process-result-line line))
|
|
|
2956
|
|
|
2957 ((string-match efs-fatal-msgs line)
|
|
|
2958 (set-process-sentinel proc nil)
|
|
|
2959 (delete-process proc)
|
|
|
2960 (setq efs-process-busy nil
|
|
|
2961 efs-process-result 'fatal
|
|
|
2962 efs-process-result-line line))
|
|
|
2963
|
|
|
2964 ((string-match efs-failed-msgs line)
|
|
|
2965 (setq efs-process-busy nil
|
|
|
2966 efs-process-result 'failed
|
|
|
2967 efs-process-result-line line))
|
|
|
2968
|
|
|
2969 ((string-match efs-unknown-response-msgs line)
|
|
|
2970 (setq efs-process-busy nil
|
|
|
2971 efs-process-result 'weird
|
|
|
2972 efs-process-result-line line)
|
|
|
2973 (efs-process-scream-and-yell line))))
|
|
|
2974
|
|
|
2975 (efs-define-fun efs-process-log-string (proc str)
|
|
|
2976 ;; For a given PROCESS, log the given STRING at the end of its
|
|
|
2977 ;; associated buffer.
|
|
|
2978 (let ((buff (get-buffer (process-buffer proc))))
|
|
|
2979 (if buff
|
|
|
2980 (efs-save-buffer-excursion
|
|
|
2981 (set-buffer buff)
|
|
|
2982 (comint-output-filter proc str)))))
|
|
|
2983
|
|
|
2984 (defun efs-process-filter (proc str)
|
|
|
2985 ;; Build up a complete line of output from the ftp PROCESS and pass it
|
|
|
2986 ;; on to efs-process-handle-line to deal with.
|
|
|
2987 (let ((inhibit-quit t)
|
|
|
2988 (buffer (get-buffer (process-buffer proc)))
|
|
|
2989 (efs-default-directory default-directory))
|
|
|
2990
|
|
|
2991 ;; see if the buffer is still around... it could have been deleted.
|
|
|
2992 (if buffer
|
|
|
2993 (efs-save-buffer-excursion
|
|
|
2994 (set-buffer (process-buffer proc))
|
|
|
2995 (efs-save-match-data
|
|
|
2996
|
|
|
2997 ;; handle hash mark printing
|
|
|
2998 (if efs-process-busy
|
|
|
2999 (setq str (efs-process-handle-hash str)
|
|
|
3000 efs-process-string (concat efs-process-string str)))
|
|
|
3001 (efs-process-log-string proc str)
|
|
|
3002 (while (and efs-process-busy
|
|
|
3003 (string-match "\n" efs-process-string))
|
|
|
3004 (let ((line (substring efs-process-string
|
|
|
3005 0
|
|
|
3006 (match-beginning 0))))
|
|
|
3007 (setq efs-process-string (substring
|
|
|
3008 efs-process-string
|
|
|
3009 (match-end 0)))
|
|
|
3010 ;; If we are in synch with the client, we should
|
|
|
3011 ;; never get prompts in the wrong place. Just to be safe,
|
|
|
3012 ;; chew them off.
|
|
|
3013 (while (string-match efs-process-prompt-regexp line)
|
|
|
3014 (setq line (substring line (match-end 0))))
|
|
|
3015 (efs-process-handle-line line proc)))
|
|
|
3016
|
|
|
3017 ;; has the ftp client finished? if so then do some clean-up
|
|
|
3018 ;; actions.
|
|
|
3019 (if (not efs-process-busy)
|
|
|
3020 (progn
|
|
|
3021 (efs-correct-hash-mark-size)
|
|
|
3022 ;; reset process-kill-without-query
|
|
|
3023 (process-kill-without-query proc)
|
|
|
3024 ;; issue the "done" message since we've finished.
|
|
|
3025 (if (and efs-process-msg
|
|
|
3026 (efs-message-p)
|
|
|
3027 (null efs-process-result))
|
|
|
3028 (progn
|
|
|
3029
|
|
|
3030 (efs-message "%s...done" efs-process-msg)
|
|
|
3031 (setq efs-process-msg nil)))
|
|
|
3032
|
|
|
3033 (if (and efs-process-nowait
|
|
|
3034 (null efs-process-cmd-waiting))
|
|
|
3035
|
|
|
3036 (progn
|
|
|
3037 ;; Is there a continuation we should be calling?
|
|
|
3038 ;; If so, we'd better call it, making sure we
|
|
|
3039 ;; only call it once.
|
|
|
3040 (if efs-process-continue
|
|
|
3041 (let ((cont efs-process-continue))
|
|
|
3042 (setq efs-process-continue nil)
|
|
|
3043 (efs-call-cont
|
|
|
3044 cont
|
|
|
3045 efs-process-result
|
|
|
3046 efs-process-result-line
|
|
|
3047 efs-process-result-cont-lines)))
|
|
|
3048 ;; If the cmd was run asynch, run the next
|
|
|
3049 ;; cmd from the queue. For synch cmds, this
|
|
|
3050 ;; is done by efs-send-cmd. For asynch
|
|
|
3051 ;; cmds we don't care about
|
|
|
3052 ;; efs-nested-cmd, since nothing is
|
|
|
3053 ;; waiting for the cmd to complete. If
|
|
|
3054 ;; efs-process-cmd-waiting is t, exit
|
|
|
3055 ;; to let this command run.
|
|
|
3056 (if (and efs-process-q
|
|
|
3057 ;; Be careful to check efs-process-busy
|
|
|
3058 ;; again, because the cont may have started
|
|
|
3059 ;; some new ftp action.
|
|
|
3060 ;; wheels within wheels...
|
|
|
3061 (null efs-process-busy))
|
|
|
3062 (let ((next (car efs-process-q)))
|
|
|
3063 (setq efs-process-q
|
|
|
3064 (cdr efs-process-q))
|
|
|
3065 (apply 'efs-send-cmd
|
|
|
3066 efs-process-host
|
|
|
3067 efs-process-user
|
|
|
3068 next))))
|
|
|
3069
|
|
|
3070 (if efs-process-continue
|
|
|
3071 (let ((cont efs-process-continue))
|
|
|
3072 (setq efs-process-continue nil)
|
|
|
3073 (efs-call-cont
|
|
|
3074 cont
|
|
|
3075 efs-process-result
|
|
|
3076 efs-process-result-line
|
|
|
3077 efs-process-result-cont-lines))))
|
|
|
3078
|
|
|
3079 ;; Update the mode line
|
|
|
3080 ;; We can't test nowait to see if we changed the
|
|
|
3081 ;; modeline in the first place, because conts
|
|
|
3082 ;; may be running now, which will confuse the issue.
|
|
|
3083 ;; The logic is simpler if we update the modeline
|
|
|
3084 ;; before the cont, but then the user sees the
|
|
|
3085 ;; modeline track the cont execution. It's dizzying.
|
|
|
3086 (if (and (or efs-mode-line-format
|
|
|
3087 efs-ftp-activity-function)
|
|
|
3088 (null efs-process-busy))
|
|
|
3089 (efs-update-mode-line)))))
|
|
|
3090
|
|
|
3091 ;; Trim buffer, if required.
|
|
|
3092 (and efs-max-ftp-buffer-size
|
|
|
3093 (zerop efs-process-cmd-counter)
|
|
|
3094 (> (point-max) efs-max-ftp-buffer-size)
|
|
|
3095 (= (point-min) 1) ; who knows, the user may have narrowed.
|
|
|
3096 (null (get-buffer-window (current-buffer)))
|
|
|
3097 (save-excursion
|
|
|
3098 (goto-char (/ efs-max-ftp-buffer-size 2))
|
|
|
3099 (forward-line 1)
|
|
|
3100 (delete-region (point-min) (point))))))))
|
|
|
3101
|
|
|
3102 ;;;; ------------------------------------------------------------------
|
|
|
3103 ;;;; Functions for counting hashes and reporting on bytes transferred.
|
|
|
3104 ;;;; ------------------------------------------------------------------
|
|
|
3105
|
|
|
3106 (defun efs-set-xfer-size (host user bytes)
|
|
|
3107 ;; Set the size of the next FTP transfer in bytes.
|
|
|
3108 (let ((proc (efs-get-process host user)))
|
|
|
3109 (if proc
|
|
|
3110 (let ((buf (process-buffer proc)))
|
|
|
3111 (if buf
|
|
|
3112 (save-excursion
|
|
|
3113 (set-buffer buf)
|
|
|
3114 (setq efs-process-xfer-size (ash bytes -10))))))))
|
|
|
3115
|
|
|
3116 (defun efs-guess-incoming-bin-hm-size ()
|
|
|
3117 ;; Guess at the hash mark size for incoming binary transfers by taking
|
|
|
3118 ;; the average value for such transfers to other hosts.
|
|
|
3119 (let ((total 0)
|
|
|
3120 (n 0))
|
|
|
3121 (efs-map-hashtable
|
|
|
3122 (function
|
|
|
3123 (lambda (host hm-size)
|
|
|
3124 (if hm-size (setq total (+ total hm-size)
|
|
|
3125 n (1+ n)))))
|
|
|
3126 efs-host-hashtable
|
|
|
3127 'incoming-bin-hm-size)
|
|
|
3128 (and (> n 0) (/ total n))))
|
|
|
3129
|
|
|
3130 (defun efs-set-hash-mark-unit (host user &optional incoming)
|
|
|
3131 ;; Sets the value of efs-process-hash-mark-unit according to the xfer-type.
|
|
|
3132 ;; efs-hash-mark-unit is the number of bytes represented by a hash mark,
|
|
|
3133 ;; in units of 16. If INCOMING is non-nil, the xfer will be a GET.
|
|
|
3134 (if efs-send-hash
|
|
|
3135 (let ((buff (efs-ftp-process-buffer host user))
|
|
|
3136 (gate-p (efs-use-gateway-p host t)))
|
|
|
3137 (if buff
|
|
|
3138 (save-excursion
|
|
|
3139 (set-buffer buff)
|
|
|
3140 (setq efs-process-hash-mark-unit
|
|
|
3141 (ash (or
|
|
|
3142 (and incoming (eq efs-process-xfer-type 'image)
|
|
|
3143 (or (efs-get-host-property
|
|
|
3144 host 'incoming-bin-hm-size)
|
|
|
3145 (if gate-p
|
|
|
3146 efs-gateway-incoming-binary-hm-size
|
|
|
3147 efs-incoming-binary-hm-size)
|
|
|
3148 (let ((guess
|
|
|
3149 (efs-guess-incoming-bin-hm-size)))
|
|
|
3150 (and guess
|
|
|
3151 (efs-set-host-property
|
|
|
3152 host 'incoming-bin-hm-size
|
|
|
3153 guess)))))
|
|
|
3154 (if gate-p
|
|
|
3155 efs-gateway-hash-mark-size
|
|
|
3156 efs-hash-mark-size)
|
|
|
3157 1024) ; make sure that we have some integer
|
|
|
3158 -4)))))))
|
|
|
3159
|
|
|
3160 (defun efs-correct-hash-mark-size ()
|
|
|
3161 ;; Corrects the value of efs-{ascii,binary}-hash-mark-size.
|
|
|
3162 ;; Must be run in the process buffer.
|
|
|
3163 (and efs-send-hash
|
|
|
3164 efs-process-hash-mark-unit
|
|
|
3165 (> efs-process-xfer-size 0)
|
|
|
3166 (< efs-process-xfer-size 524288) ; 2^19, prevent overflows
|
|
|
3167 (> efs-process-hash-mark-count 0)
|
|
|
3168 (or (> efs-process-last-percent 100)
|
|
|
3169 (< (ash (* efs-process-hash-mark-unit
|
|
|
3170 (1+ efs-process-hash-mark-count )) -6)
|
|
|
3171 efs-process-xfer-size))
|
|
|
3172 (let ((val (ash (/ (ash efs-process-xfer-size 6)
|
|
|
3173 efs-process-hash-mark-count) 4)))
|
|
|
3174 (if (and (eq efs-process-xfer-type 'image)
|
|
|
3175 (>= (length efs-process-cmd) 4)
|
|
|
3176 (string-equal (downcase (substring efs-process-cmd 0 4))
|
|
|
3177 "get "))
|
|
|
3178 (efs-set-host-property efs-process-host 'incoming-bin-hm-size val)
|
|
|
3179 (set (if (efs-use-gateway-p efs-process-host t)
|
|
|
3180 'efs-gateway-hash-mark-size
|
|
|
3181 'efs-hash-mark-size)
|
|
|
3182 val)))))
|
|
|
3183
|
|
|
3184 (defun efs-process-handle-hash (str)
|
|
|
3185 ;; Remove hash marks from STRING and display count so far.
|
|
|
3186 (if (string-match "^#+$" str)
|
|
|
3187 (progn
|
|
|
3188 (setq efs-process-hash-mark-count
|
|
|
3189 (+ efs-process-hash-mark-count
|
|
|
3190 (- (match-end 0) (match-beginning 0))))
|
|
|
3191 (and
|
|
|
3192 efs-process-msg
|
|
|
3193 efs-process-hash-mark-unit
|
|
|
3194 (not (and efs-process-nowait
|
|
|
3195 (or (eq efs-verbose 0)
|
|
|
3196 (eq (selected-window) (minibuffer-window)))))
|
|
|
3197 (efs-message-p)
|
|
|
3198 (let* ((big (> efs-process-hash-mark-count 65536)) ; 2^16
|
|
|
3199 (kbytes (if big
|
|
|
3200 (* efs-process-hash-mark-unit
|
|
|
3201 (ash efs-process-hash-mark-count -6))
|
|
|
3202 (ash (* efs-process-hash-mark-unit
|
|
|
3203 efs-process-hash-mark-count)
|
|
|
3204 -6))))
|
|
|
3205 (if (zerop efs-process-xfer-size)
|
|
|
3206 (or (zerop kbytes)
|
|
|
3207 (efs-message "%s...%dk" efs-process-msg kbytes))
|
|
|
3208 (let ((percent (if big
|
|
|
3209 (/ (* 100 (ash kbytes -7))
|
|
|
3210 (ash efs-process-xfer-size -7))
|
|
|
3211 (/ (* 100 kbytes) efs-process-xfer-size))))
|
|
|
3212 ;; Don't display %'s betwwen 100 and 110
|
|
|
3213 (and (> percent 100) (< percent 110) (setq percent 100))
|
|
|
3214 ;; cut out the redisplay of identical %-age messages.
|
|
|
3215 (or (eq percent efs-process-last-percent)
|
|
|
3216 (progn
|
|
|
3217 (setq efs-process-last-percent percent)
|
|
|
3218 (efs-message "%s...%d%%" efs-process-msg percent)))))))
|
|
|
3219 (concat (substring str 0 (match-beginning 0))
|
|
|
3220 (and (/= (length str) (match-end 0))
|
|
|
3221 (substring str (1+ (match-end 0))))))
|
|
|
3222 str))
|
|
|
3223
|
|
|
3224 ;;;; ------------------------------------------------------------------
|
|
|
3225 ;;;; Keeping track of the number of active background connections.
|
|
|
3226 ;;;; ------------------------------------------------------------------
|
|
|
3227
|
|
|
3228 (defun efs-ftp-processes-active ()
|
|
|
3229 ;; Return the number of FTP processes busy.
|
|
|
3230 (save-excursion
|
|
|
3231 (length
|
|
|
3232 (delq nil
|
|
|
3233 (mapcar
|
|
|
3234 (function
|
|
|
3235 (lambda (buff)
|
|
|
3236 (set-buffer buff)
|
|
|
3237 (and (boundp 'efs-process-busy)
|
|
|
3238 efs-process-busy)))
|
|
|
3239 (buffer-list))))))
|
|
|
3240
|
|
|
3241 (defun efs-update-mode-line ()
|
|
|
3242 ;; Updates the mode with FTP activity, and runs `efs-ftp-activity-function'.
|
|
|
3243 (let ((num (efs-ftp-processes-active)))
|
|
|
3244 (if efs-mode-line-format
|
|
|
3245 (progn
|
|
|
3246 (if (zerop num)
|
|
|
3247 (setq efs-mode-line-string "")
|
|
|
3248 (setq efs-mode-line-string (format efs-mode-line-format num)))
|
|
|
3249 ;; fake emacs into re-calculating all the mode lines.
|
|
|
3250 (save-excursion (set-buffer (other-buffer)))
|
|
|
3251 (set-buffer-modified-p (buffer-modified-p))))
|
|
|
3252 (if efs-ftp-activity-function
|
|
|
3253 (funcall efs-ftp-activity-function num))))
|
|
|
3254
|
|
42
|
3255 ;;;###autoload
|
|
22
|
3256 (defun efs-display-ftp-activity ()
|
|
42
|
3257 "Displays the number of active background ftp sessions in the modeline.
|
|
22
|
3258 Uses the variable `efs-mode-line-format' to determine how this will be
|
|
|
3259 displayed."
|
|
|
3260 (interactive)
|
|
|
3261 (or (memq 'efs-mode-line-string global-mode-string)
|
|
|
3262 (if global-mode-string
|
|
|
3263 (nconc global-mode-string '(efs-mode-line-string))
|
|
|
3264 (setq global-mode-string '("" efs-mode-line-string)))))
|
|
|
3265
|
|
|
3266 ;;;; -------------------------------------------------------------------
|
|
|
3267 ;;;; Expiring inactive ftp buffers.
|
|
|
3268 ;;;; -------------------------------------------------------------------
|
|
|
3269
|
|
|
3270 (defun efs-start-polling ()
|
|
|
3271 ;; Start polling FTP buffers, to look for idle ones.
|
|
|
3272 (or (null efs-expire-ftp-buffers)
|
|
|
3273 (let ((proc (get-process "efs poll")))
|
|
|
3274 (or (and proc (eq (process-status proc) 'run))))
|
|
|
3275 (let ((default-directory exec-directory)
|
|
|
3276 (process-connection-type nil)
|
|
|
3277 new-proc)
|
|
|
3278 (condition-case nil
|
|
|
3279 (delete-process "efs poll")
|
|
|
3280 (error nil))
|
|
|
3281 (setq new-proc (start-process
|
|
|
3282 "efs poll" nil
|
|
|
3283 (concat exec-directory "wakeup")
|
|
|
3284 (int-to-string efs-ftp-buffer-poll-time)))
|
|
|
3285 (set-process-filter new-proc (function efs-expire-ftp-buffers-filter))
|
|
|
3286 (process-kill-without-query new-proc))))
|
|
|
3287
|
|
|
3288 (defun efs-connection-visited-p (host user)
|
|
|
3289 ;; Returns t if there are any buffers visiting files on HOST and USER.
|
|
|
3290 (save-excursion
|
|
|
3291 (let ((list (buffer-list))
|
|
|
3292 (case-fold (memq (efs-host-type host)
|
|
|
3293 efs-case-insensitive-host-types))
|
|
|
3294 (visited nil)
|
|
|
3295 parsed)
|
|
|
3296 (setq host (downcase host))
|
|
|
3297 (if case-fold (setq user (downcase user)))
|
|
|
3298 (while list
|
|
|
3299 (set-buffer (car list))
|
|
|
3300 (if (or (and buffer-file-name
|
|
|
3301 (setq parsed (efs-ftp-path buffer-file-name))
|
|
|
3302 (string-equal host (downcase (car parsed)))
|
|
|
3303 (string-equal user (if case-fold
|
|
|
3304 (downcase (nth 1 parsed))
|
|
|
3305 (nth 1 parsed))))
|
|
|
3306 (and (boundp 'dired-directory)
|
|
|
3307 (stringp dired-directory)
|
|
|
3308 efs-dired-host-type
|
|
|
3309 (setq parsed (efs-ftp-path dired-directory))
|
|
|
3310 (string-equal host (downcase (car parsed)))
|
|
|
3311 (string-equal user (if case-fold
|
|
|
3312 (downcase (nth 1 parsed))
|
|
|
3313 (nth 1 parsed)))))
|
|
|
3314 (setq visited t
|
|
|
3315 list nil)
|
|
|
3316 (setq list (cdr list))))
|
|
|
3317 visited)))
|
|
|
3318
|
|
|
3319 (defun efs-expire-ftp-buffers-filter (proc string)
|
|
|
3320 ;; Check all ftp buffers, and kill them if they have been inactive
|
|
|
3321 ;; for the minimum of efs-ftp-buffer-expire-time and their local
|
|
|
3322 ;; time out time.
|
|
|
3323 (if efs-expire-ftp-buffers
|
|
|
3324 (let ((list (buffer-list))
|
|
|
3325 new-alist)
|
|
|
3326 (save-excursion
|
|
|
3327 (while list
|
|
|
3328 (set-buffer (car list))
|
|
|
3329 (if (eq major-mode 'efs-mode)
|
|
|
3330 (let* ((proc (get-buffer-process (current-buffer)))
|
|
|
3331 (proc-p (and proc (memq (process-status proc)
|
|
|
3332 '(run open)))))
|
|
|
3333 (if (or efs-ftp-buffer-expire-time
|
|
|
3334 efs-process-idle-time
|
|
|
3335 (null proc-p))
|
|
|
3336 (let ((elt (assq (car list) efs-ftp-buffer-alist))
|
|
|
3337 (wind-p (get-buffer-window (car list))))
|
|
|
3338 (if (or (null elt) (buffer-modified-p)
|
|
|
3339 efs-process-busy wind-p)
|
|
|
3340 (progn
|
|
|
3341 (setq new-alist (cons (cons (car list) 0)
|
|
|
3342 new-alist))
|
|
|
3343 (or wind-p (set-buffer-modified-p nil)))
|
|
|
3344 (let ((idle (+ (cdr elt)
|
|
|
3345 efs-ftp-buffer-poll-time)))
|
|
|
3346 (if (and proc-p
|
|
|
3347 (< idle
|
|
|
3348 (if efs-ftp-buffer-expire-time
|
|
|
3349 (if efs-process-idle-time
|
|
|
3350 (min efs-ftp-buffer-expire-time
|
|
|
3351 efs-process-idle-time)
|
|
|
3352 efs-ftp-buffer-expire-time)
|
|
|
3353 efs-process-idle-time)))
|
|
|
3354 (progn
|
|
|
3355 (setq new-alist (cons (cons (car list) idle)
|
|
|
3356 new-alist))
|
|
|
3357 (set-buffer-modified-p nil))
|
|
|
3358 ;; If there are still buffers for host & user,
|
|
|
3359 ;; don't wipe the cache.
|
|
|
3360 (and proc
|
|
|
3361 (efs-connection-visited-p
|
|
|
3362 efs-process-host efs-process-user)
|
|
|
3363 (set-process-sentinel proc nil))
|
|
|
3364 (kill-buffer (car list)))))))))
|
|
|
3365 (setq list (cdr list))))
|
|
|
3366 (setq efs-ftp-buffer-alist new-alist))
|
|
|
3367 (condition-case nil
|
|
|
3368 (delete-process "efs poll")
|
|
|
3369 (error nil))))
|
|
|
3370
|
|
|
3371 ;;;; -------------------------------------------------------------------
|
|
|
3372 ;;;; When the FTP client process dies...
|
|
|
3373 ;;;; -------------------------------------------------------------------
|
|
|
3374
|
|
|
3375 (defun efs-process-sentinel (proc str)
|
|
|
3376 ;; When ftp process changes state, nuke all file-entries in cache.
|
|
|
3377 (let ((buff (process-buffer proc)))
|
|
|
3378 ;; If the client dies, make sure that efs doesn't think that
|
|
|
3379 ;; there is a running process.
|
|
|
3380 (save-excursion
|
|
|
3381 (condition-case nil
|
|
|
3382 (progn
|
|
|
3383 (set-buffer buff)
|
|
|
3384 (setq efs-process-busy nil))
|
|
|
3385 (error nil)))
|
|
|
3386 (let ((parsed (efs-parse-proc-name proc)))
|
|
|
3387 (if parsed
|
|
|
3388 (progn
|
|
|
3389 (apply 'efs-wipe-file-entries parsed)
|
|
|
3390 (apply 'efs-wipe-from-ls-cache parsed))))
|
|
|
3391 (if (or efs-mode-line-format efs-ftp-activity-function)
|
|
|
3392 (efs-update-mode-line))))
|
|
|
3393
|
|
|
3394 (defun efs-kill-ftp-process (buffer)
|
|
|
3395 "Kill an FTP connection and its associated process buffer.
|
|
|
3396 If the BUFFER's visited file name or default-directory is an efs remote
|
|
|
3397 file name, it is the connection for that file name that is killed."
|
|
|
3398 (interactive "bKill FTP process associated with buffer: ")
|
|
|
3399 (or buffer (setq buffer (current-buffer)))
|
|
|
3400 (save-excursion
|
|
|
3401 (set-buffer buffer)
|
|
|
3402 (if (eq major-mode 'efs-mode)
|
|
|
3403 (kill-buffer buffer)
|
|
|
3404 (let ((file (or (buffer-file-name) default-directory)))
|
|
|
3405 (if file
|
|
|
3406 (let ((parsed (efs-ftp-path (expand-file-name file))))
|
|
|
3407 (if parsed
|
|
|
3408 (let ((host (nth 0 parsed))
|
|
|
3409 (user (nth 1 parsed)))
|
|
|
3410 (kill-buffer
|
|
|
3411 (efs-ftp-process-buffer host user))))))))))
|
|
|
3412
|
|
|
3413 (defun efs-close-ftp-process (buffer)
|
|
|
3414 "Close an FTP connection.
|
|
|
3415 This kills the FTP client process, but unlike `efs-kill-ftp-process' this
|
|
|
3416 neither kills the process buffer, nor deletes cached data for the connection."
|
|
|
3417 (interactive "bClose FTP process associated with buffer: ")
|
|
|
3418 (or buffer (setq buffer (current-buffer)))
|
|
|
3419 (save-excursion
|
|
|
3420 (set-buffer buffer)
|
|
|
3421 (if (eq major-mode 'efs-mode)
|
|
|
3422 (let ((process (get-buffer-process buffer)))
|
|
|
3423 (if process
|
|
|
3424 (progn
|
|
|
3425 (set-process-sentinel process nil)
|
|
|
3426 (setq efs-process-busy nil
|
|
|
3427 efs-process-q nil)
|
|
|
3428 (if (or efs-mode-line-format efs-ftp-activity-function)
|
|
|
3429 (efs-update-mode-line))
|
|
|
3430 (delete-process process))))
|
|
|
3431 (let ((file (or (buffer-file-name) default-directory)))
|
|
|
3432 (if file
|
|
|
3433 (let ((parsed (efs-ftp-path (expand-file-name file))))
|
|
|
3434 (if parsed
|
|
|
3435 (let ((process (get-process
|
|
|
3436 (format "*ftp %s@%s*"
|
|
|
3437 (nth 1 parsed) (car parsed)))))
|
|
|
3438 (if process
|
|
|
3439 (progn
|
|
|
3440 (set-buffer (process-buffer process))
|
|
|
3441 (set-process-sentinel process nil)
|
|
|
3442 (setq efs-process-busy nil
|
|
|
3443 efs-process-q nil)
|
|
|
3444 (if (or efs-mode-line-format
|
|
|
3445 efs-ftp-activity-function)
|
|
|
3446 (efs-update-mode-line))
|
|
|
3447 (delete-process process)))))))))))
|
|
|
3448
|
|
|
3449 (defun efs-ping-ftp-connection (buffer)
|
|
|
3450 "Ping a connection by sending a NOOP command.
|
|
|
3451 Useful for waking up a possible expired connection."
|
|
|
3452 (interactive "bPing FTP connection associated with buffer: ")
|
|
|
3453 (or buffer (setq buffer (current-buffer)))
|
|
|
3454 (efs-save-buffer-excursion
|
|
|
3455 (set-buffer buffer)
|
|
|
3456 (let (file host user parsed)
|
|
|
3457 (if (or (and (eq major-mode 'efs-mode)
|
|
|
3458 (setq host efs-process-host
|
|
|
3459 user efs-process-user))
|
|
|
3460 (and (setq file (or (buffer-file-name) default-directory))
|
|
|
3461 (setq parsed (efs-ftp-path file))
|
|
|
3462 (setq host (car parsed)
|
|
|
3463 user (nth 1 parsed))))
|
|
|
3464 (or (car
|
|
|
3465 (efs-send-cmd
|
|
|
3466 host user '(quote noop)
|
|
|
3467 (format "Pinging connection %s@%s" user host)))
|
|
|
3468 (message "Connection %s@%s is alive." user host))))))
|
|
|
3469
|
|
|
3470 (defun efs-display-ftp-process-buffer (buffer)
|
|
|
3471 "Displays the FTP process buffer associated with the current buffer."
|
|
|
3472 (interactive "bDisplay FTP buffer associated with buffer: ")
|
|
|
3473 (if (null buffer) (setq buffer (current-buffer)))
|
|
|
3474 (let ((file (or (buffer-file-name) default-directory))
|
|
|
3475 parsed proc-buffer)
|
|
|
3476 (if (and file (setq parsed (efs-ftp-path file))
|
|
|
3477 (setq proc-buffer (get-buffer (efs-ftp-process-buffer
|
|
|
3478 (car parsed)
|
|
|
3479 (nth 1 parsed)))))
|
|
|
3480 (display-buffer proc-buffer)
|
|
|
3481 (error "Buffer %s not associated with an FTP process" buffer))))
|
|
|
3482
|
|
|
3483 ;;;; -------------------------------------------------------------------
|
|
|
3484 ;;;; Starting the FTP client process
|
|
|
3485 ;;;; -------------------------------------------------------------------
|
|
|
3486
|
|
|
3487 (defun efs-ftp-process-buffer (host user)
|
|
|
3488 "Return name of the process buffer for ftp process for HOST and USER."
|
|
|
3489 ;; Host names on the internet are case-insensitive.
|
|
|
3490 (format efs-ftp-buffer-format user (downcase host)))
|
|
|
3491
|
|
|
3492 (defun efs-pty-check (proc threshold)
|
|
|
3493 ;; Checks to see if PROC is a pty. Beware, it clobbers the process
|
|
|
3494 ;; filter, so run this before you set the filter.
|
|
|
3495 ;; THRESHOLD is an integer to tell it how long to wait for output.
|
|
|
3496 (sit-for 0) ; Update the display before doing any waiting.
|
|
|
3497 (let ((efs-pipe-p t)
|
|
|
3498 (n 0))
|
|
|
3499 (set-process-filter proc (function (lambda (proc string)
|
|
|
3500 (setq efs-pipe-p nil))))
|
|
|
3501 (while (and (< n threshold) efs-pipe-p)
|
|
|
3502 (accept-process-output)
|
|
|
3503 (setq n (1+ n)))
|
|
|
3504 (if efs-pipe-p
|
|
|
3505 (progn
|
|
|
3506 (sit-for 0) ; update display
|
|
|
3507 ;; Use a sleep-for as I don't want pty-checking to depend
|
|
|
3508 ;; on pending input.
|
|
|
3509 (sleep-for efs-pty-check-retry-time)))
|
|
|
3510 (accept-process-output)
|
|
|
3511 (if efs-pipe-p
|
|
|
3512 (if (or noninteractive
|
|
|
3513 (progn
|
|
|
3514 ;; in case the user typed something during the wait.
|
|
|
3515 (discard-input)
|
|
|
3516 (y-or-n-p
|
|
|
3517 (format "%s seems not a pty. Kill? " proc))))
|
|
|
3518 (progn
|
|
|
3519 (kill-buffer (process-buffer proc))
|
|
|
3520 (if (eq (selected-window) (minibuffer-window))
|
|
|
3521 (abort-recursive-edit)
|
|
|
3522 (signal 'quit nil))))
|
|
|
3523 ;; Need to send a \n to make sure, because sometimes we get the startup
|
|
|
3524 ;; prompt from a pipe.
|
|
|
3525 (sit-for 0)
|
|
|
3526 (process-send-string proc "\n")
|
|
|
3527 (setq efs-pipe-p t
|
|
|
3528 n 0)
|
|
|
3529 (while (and (< n threshold) efs-pipe-p)
|
|
|
3530 (accept-process-output)
|
|
|
3531 (setq n (1+ n)))
|
|
|
3532 (if efs-pipe-p
|
|
|
3533 (progn
|
|
|
3534 (sit-for 0)
|
|
|
3535 (sleep-for efs-pty-check-retry-time)))
|
|
|
3536 (accept-process-output)
|
|
|
3537 (if (and efs-pipe-p
|
|
|
3538 (or noninteractive
|
|
|
3539 (progn
|
|
|
3540 ;; in case the user typed something during the wait.
|
|
|
3541 (discard-input)
|
|
|
3542 (y-or-n-p
|
|
|
3543 (format "%s seems not a pty. Kill? " proc)))))
|
|
|
3544 (progn
|
|
|
3545 (kill-buffer (process-buffer proc))
|
|
|
3546 (if (eq (selected-window) (minibuffer-window))
|
|
|
3547 (abort-recursive-edit)
|
|
|
3548 (signal 'quit nil)))))))
|
|
|
3549
|
|
|
3550 (defun efs-start-process (host user name)
|
|
|
3551 "Spawn a new ftp process ready to connect to machine HOST as USER.
|
|
|
3552 If HOST is only ftp-able through a gateway machine then spawn a shell
|
|
|
3553 on the gateway machine to do the ftp instead. NAME is the name of the
|
|
|
3554 process."
|
|
|
3555 (let* ((use-gateway (efs-use-gateway-p host))
|
|
|
3556 (buffer (get-buffer-create (efs-ftp-process-buffer host user)))
|
|
|
3557 (process-connection-type t)
|
|
|
3558 (opaque-p (memq use-gateway efs-opaque-gateways))
|
|
|
3559 proc)
|
|
|
3560 (save-excursion
|
|
|
3561 (set-buffer buffer)
|
|
|
3562 (efs-mode host user (if opaque-p
|
|
|
3563 efs-gateway-ftp-prompt-regexp
|
|
|
3564 efs-ftp-prompt-regexp)))
|
|
|
3565 (cond
|
|
|
3566 ((null use-gateway)
|
|
|
3567 (message "Opening FTP connection to %s..." host)
|
|
|
3568 (setq proc (apply 'start-process name buffer efs-ftp-program-name
|
|
|
3569 efs-ftp-program-args)))
|
|
|
3570 ((eq use-gateway 'interactive)
|
|
|
3571 (setq proc (efs-gwp-start host user name)))
|
|
|
3572 ((eq use-gateway 'remsh)
|
|
|
3573 (message "Opening FTP connection to %s via %s..." host efs-gateway-host)
|
|
|
3574 (setq proc (apply 'start-process name buffer (nth 1 efs-gateway-type)
|
|
|
3575 (append (list efs-gateway-host)
|
|
|
3576 (nth 2 efs-gateway-type)
|
|
|
3577 (list (nth 3 efs-gateway-type))
|
|
|
3578 (nth 4 efs-gateway-type)))))
|
|
|
3579 ((memq use-gateway '(proxy raptor interlock kerberos))
|
|
|
3580 (message "Opening FTP connection to %s via %s..." host efs-gateway-host)
|
|
|
3581 (setq proc (apply 'start-process name buffer (nth 1 efs-gateway-type)
|
|
|
3582 (nth 2 efs-gateway-type))))
|
|
|
3583 ((eq use-gateway 'local)
|
|
|
3584 (message "Opening FTP connection to %s..." host)
|
|
|
3585 (setq proc (apply 'start-process name buffer (nth 1 efs-gateway-type)
|
|
|
3586 (nth 2 efs-gateway-type))))
|
|
|
3587 ((error "Never heard of gateway type %s" use-gateway)))
|
|
|
3588 (process-kill-without-query proc)
|
|
|
3589 (if opaque-p
|
|
|
3590 (accept-process-output proc)
|
|
|
3591 (if efs-pty-check-threshold
|
|
|
3592 (efs-pty-check proc efs-pty-check-threshold)
|
|
|
3593 (accept-process-output proc)))
|
|
|
3594 (set-process-sentinel proc (function efs-process-sentinel))
|
|
|
3595 (set-process-filter proc (function efs-process-filter))
|
|
|
3596 (efs-start-polling)
|
|
|
3597 (save-excursion
|
|
|
3598 (set-buffer buffer)
|
|
|
3599 (goto-char (point-max))
|
|
|
3600 (set-marker (process-mark proc) (point)))
|
|
|
3601 proc))
|
|
|
3602
|
|
|
3603 (defun efs-get-process-internal (host user)
|
|
|
3604 ;; Get's the first process for HOST and USER. If HOST runs a
|
|
|
3605 ;; a case insignificant OS, then case is not considered in USER.
|
|
|
3606 (let ((list (process-list))
|
|
|
3607 (case-fold (memq (efs-host-type host)
|
|
|
3608 efs-case-insensitive-host-types))
|
|
|
3609 (len (+ (length host) (length user) 7))
|
|
|
3610 fmt name found)
|
|
|
3611 (setq host (downcase host))
|
|
|
3612 (if case-fold (setq user (downcase user)))
|
|
|
3613 (while (and (not found) list)
|
|
|
3614 (setq name (process-name (car list)))
|
|
|
3615 (if (and (= (length name) len)
|
|
|
3616 (string-equal (substring name 0 5) "*ftp ")
|
|
|
3617 (string-equal
|
|
|
3618 (if case-fold (downcase (substring name 5)) (substring name 5))
|
|
|
3619 (or fmt (setq fmt (format "%s@%s*" user host))))
|
|
|
3620 (memq (process-status (car list)) '(run open)))
|
|
|
3621 (setq found (car list))
|
|
|
3622 (setq list (cdr list))))
|
|
|
3623 found))
|
|
|
3624
|
|
|
3625 ;; efs-guess-host-type calls this
|
|
|
3626 ;; function recursively. The (if (and proc... avoids an infinite
|
|
|
3627 ;; loop. We should make sure that this won't hang things if the
|
|
|
3628 ;; connection goes wrong.
|
|
|
3629
|
|
|
3630 (defun efs-get-process (host user)
|
|
|
3631 "Return the process object for the FTP process for HOST and USER.
|
|
|
3632 Create a new process if needed."
|
|
|
3633
|
|
|
3634 (let ((proc (efs-get-process-internal host user)))
|
|
|
3635 (if (and proc (memq (process-status proc) '(run open)))
|
|
|
3636 proc
|
|
|
3637
|
|
|
3638 ;; Make sure that the process isn't around in some strange state.
|
|
|
3639
|
|
|
3640 (setq host (downcase host))
|
|
|
3641 (let ((name (concat "*ftp " user "@" host "*")))
|
|
|
3642 (if proc (condition-case nil (delete-process proc) (error nil)))
|
|
|
3643
|
|
|
3644 ;; grab a suitable process.
|
|
|
3645 (setq proc (efs-start-process host user name))
|
|
|
3646
|
|
|
3647 (efs-save-match-data
|
|
|
3648 (efs-save-buffer-excursion
|
|
|
3649 (set-buffer (process-buffer proc))
|
|
|
3650
|
|
|
3651 ;; Run any user-specified hooks.
|
|
|
3652 (run-hooks 'efs-ftp-startup-hook)
|
|
|
3653
|
|
|
3654 ;; login to FTP server.
|
|
|
3655 (efs-login host user proc)
|
|
|
3656
|
|
|
3657 ;; Beware, the process may have died if the login went bad.
|
|
|
3658 (if (memq (process-status proc) '(run open))
|
|
|
3659
|
|
|
3660 (progn
|
|
|
3661 ;; Tell client to send back hash-marks as progress. It isn't
|
|
|
3662 ;; usually fatal if this command fails.
|
|
|
3663 (efs-guess-hash-mark-size proc)
|
|
48
|
3664
|
|
|
3665 (if efs-use-passive-mode
|
|
|
3666 (efs-passive-mode host user))
|
|
22
|
3667
|
|
|
3668 ;; Run any user startup functions
|
|
|
3669 (let ((alist efs-ftp-startup-function-alist)
|
|
|
3670 (case-fold-search t))
|
|
|
3671 (while alist
|
|
|
3672 (if (string-match (car (car alist)) host)
|
|
|
3673 (progn
|
|
|
3674 (funcall (cdr (car alist)) host user)
|
|
|
3675 (setq alist nil))
|
|
|
3676 (setq alist (cdr alist)))))
|
|
|
3677
|
|
|
3678 ;; Guess at the host type.
|
|
|
3679 (efs-guess-host-type host user)
|
|
|
3680
|
|
|
3681 ;; Check the idle time.
|
|
|
3682 (efs-check-idle host user)
|
|
|
3683
|
|
|
3684 proc)
|
|
|
3685
|
|
|
3686 ;; Hopefully a recursive retry worked.
|
|
|
3687 (or (efs-get-process-internal host user)
|
|
|
3688 (error "No FTP process for %s@%s" user host)))))))))
|
|
|
3689
|
|
|
3690 (defun efs-guess-hash-mark-size (proc)
|
|
|
3691 ;; Doesn't run efs-save-match-data. You must do that yourself.
|
|
|
3692 (if efs-send-hash
|
|
|
3693 (save-excursion
|
|
|
3694 (set-buffer (process-buffer proc))
|
|
|
3695 (let ((line (nth 1 (efs-raw-send-cmd proc "hash")))
|
|
|
3696 (gate-p (efs-use-gateway-p efs-process-host t)))
|
|
|
3697 ;; Don't guess if the hash-mark-size is already set.
|
|
|
3698 (or (if gate-p efs-gateway-hash-mark-size efs-hash-mark-size)
|
|
|
3699 (if (string-match efs-hash-mark-msgs line)
|
|
|
3700 (let ((size (substring line (match-beginning 1)
|
|
|
3701 (match-end 1))))
|
|
|
3702 (if (string-match "^[0-9]+$" size)
|
|
|
3703 (set (if gate-p
|
|
|
3704 'efs-gateway-hash-mark-size
|
|
|
3705 'efs-hash-mark-size)
|
|
|
3706 (string-to-int size))))))))))
|
|
|
3707
|
|
48
|
3708 (defun efs-passive-mode (host user)
|
|
|
3709 ;; put ftp into passive mode
|
|
|
3710 (efs-send-cmd host user '(passive)))
|
|
|
3711
|
|
22
|
3712 ;;;; ------------------------------------------------------------
|
|
|
3713 ;;;; Simple FTP process shell support.
|
|
|
3714 ;;;; ------------------------------------------------------------
|
|
|
3715
|
|
|
3716 (defun efs-mode (host user prompt)
|
|
|
3717 "Major mode for interacting with an FTP process.
|
|
|
3718 The user interface for sending commands to the FTP process is `comint-mode'.
|
|
|
3719 For more information see the documentation for `comint-mode'. This command
|
|
|
3720 is not intended for interactive use.
|
|
|
3721 Takes arguments: HOST USER PROMPT
|
|
|
3722
|
|
|
3723 Runs efs-mode-hook if it is not nil.
|
|
|
3724
|
|
|
3725 Key map:
|
|
|
3726 \\{comint-mode-map}"
|
|
|
3727 (let ((proc (get-buffer-process (current-buffer))))
|
|
|
3728 ;; Running comint-mode will kill-all-local-variables.
|
|
|
3729 (comint-mode)
|
|
|
3730 ;; All these variables are buffer local.
|
|
|
3731 (setq major-mode 'efs-mode
|
|
|
3732 mode-name "efs"
|
|
|
3733 default-directory (file-name-directory efs-tmp-name-template)
|
|
|
3734 comint-prompt-regexp prompt
|
|
|
3735 efs-process-host host
|
|
|
3736 efs-process-user user
|
|
|
3737 efs-process-prompt-regexp prompt)
|
|
|
3738 (set (make-local-variable 'paragraph-start) comint-prompt-regexp)
|
|
|
3739 ;; Old versions of comint don't have this. It does no harm for
|
|
|
3740 ;; the newer ones.
|
|
|
3741 (set (make-local-variable 'comint-last-input-start) (make-marker))
|
|
|
3742 (goto-char (point-max))
|
|
|
3743 ;; in case there is a running process
|
|
|
3744 (if proc (set-marker (process-mark proc) (point)))
|
|
|
3745 (run-hooks 'efs-mode-hook)))
|
|
|
3746
|
|
|
3747
|
|
|
3748 ;;;; =============================================================
|
|
|
3749 ;;;; >6
|
|
|
3750 ;;;; Sending commands to the FTP server.
|
|
|
3751 ;;;; =============================================================
|
|
|
3752
|
|
|
3753 ;;;; -------------------------------------------------------------
|
|
|
3754 ;;;; General purpose functions for sending commands.
|
|
|
3755 ;;;; -------------------------------------------------------------
|
|
|
3756
|
|
|
3757 (defun efs-raw-send-cmd (proc cmd &optional msg pre-cont cont nowait)
|
|
|
3758 ;; Low-level routine to send the given ftp CMD to the ftp PROCESS.
|
|
|
3759 ;; MSG is an optional message to output before and after the command.
|
|
|
3760 ;; If PRE-CONT is non-nil, it is called immediately after execution
|
|
|
3761 ;; of the command starts, but without waiting for it to finish.
|
|
|
3762 ;; If CONT is non-NIL then it is either a function or a list of function and
|
|
|
3763 ;; some arguments. The function will be called when the ftp command has
|
|
|
3764 ;; completed.
|
|
|
3765 ;; If CONT is NIL then this routine will return \( RESULT . LINE \) where
|
|
|
3766 ;; RESULT is whether the command was successful, and LINE is the line from
|
|
|
3767 ;; the FTP process that caused the command to complete.
|
|
|
3768 ;; If NOWAIT is nil then we will wait for the command to complete before
|
|
|
3769 ;; returning. If NOWAIT is 0, then we will wait until the command starts,
|
|
|
3770 ;; executing before returning. NOWAIT of 1 is like 0, except that the modeline
|
|
|
3771 ;; will indicate an asynch FTP command.
|
|
|
3772 ;; If NOWAIT has any other value, then we will simply queue the
|
|
|
3773 ;; command. In all cases, CONT will still be called
|
|
|
3774
|
|
|
3775 (if (memq (process-status proc) '(run open))
|
|
|
3776 (efs-save-buffer-excursion
|
|
|
3777 (set-buffer (process-buffer proc))
|
|
|
3778
|
|
|
3779 (if efs-process-busy
|
|
|
3780 ;; This function will always wait on a busy process.
|
|
|
3781 ;; Queueing is done by efs-send-cmd.
|
|
|
3782 (let ((efs-process-cmd-waiting t))
|
|
|
3783 (efs-kbd-quit-protect proc
|
|
|
3784 (while efs-process-busy
|
|
|
3785 (accept-process-output)))))
|
|
|
3786
|
|
|
3787 (setq efs-process-string ""
|
|
|
3788 efs-process-result-line ""
|
|
|
3789 efs-process-result-cont-lines ""
|
|
|
3790 efs-process-busy t
|
|
|
3791 efs-process-msg (and efs-verbose msg)
|
|
|
3792 efs-process-continue cont
|
|
|
3793 efs-process-server-confused nil
|
|
|
3794 efs-process-nowait nowait
|
|
|
3795 efs-process-hash-mark-count 0
|
|
|
3796 efs-process-last-percent -1
|
|
|
3797 efs-process-xfer-size 0
|
|
|
3798 efs-process-cmd-counter (% (1+ efs-process-cmd-counter) 16))
|
|
|
3799 (process-kill-without-query proc t)
|
|
|
3800 (and efs-process-msg
|
|
|
3801 (efs-message-p)
|
|
|
3802 (efs-message "%s..." efs-process-msg))
|
|
|
3803 (goto-char (point-max))
|
|
|
3804 (move-marker comint-last-input-start (point))
|
|
|
3805 (move-marker comint-last-input-end (point))
|
|
|
3806 ;; don't insert the password into the buffer on the USER command.
|
|
|
3807 (efs-save-match-data
|
|
|
3808 (if (string-match efs-passwd-cmds cmd)
|
|
|
3809 (insert (setq efs-process-cmd
|
|
|
3810 (substring cmd 0 (match-end 0)))
|
|
|
3811 " Turtle Power!\n")
|
|
|
3812 (setq efs-process-cmd cmd)
|
|
|
3813 (insert cmd "\n")))
|
|
|
3814 (process-send-string proc (concat cmd "\n"))
|
|
|
3815 (set-marker (process-mark proc) (point))
|
|
|
3816 ;; Update the mode-line
|
|
|
3817 (if (and (or efs-mode-line-format efs-ftp-activity-function)
|
|
|
3818 (memq nowait '(t 1)))
|
|
|
3819 (efs-update-mode-line))
|
|
|
3820 (if pre-cont
|
|
|
3821 (let ((efs-nested-cmd t))
|
|
|
3822 (save-excursion
|
|
|
3823 (apply (car pre-cont) (cdr pre-cont)))))
|
|
|
3824 (prog1
|
|
|
3825 (if nowait
|
|
|
3826 nil
|
|
|
3827 ;; hang around for command to complete
|
|
|
3828 ;; Some clients die after the command is sent, if the server
|
|
|
3829 ;; times out. Don't wait on dead processes.
|
|
|
3830 (efs-kbd-quit-protect proc
|
|
|
3831 (while (and efs-process-busy
|
|
|
3832 ;; Need to recheck nowait, since it may get reset
|
|
|
3833 ;; in a cont.
|
|
|
3834 (null efs-process-nowait)
|
|
|
3835 (memq (process-status proc) '(run open)))
|
|
|
3836 (accept-process-output proc)))
|
|
|
3837
|
|
|
3838 ;; cont is called by the process filter
|
|
|
3839 (if cont
|
|
|
3840 ;; Return nil if a cont was called.
|
|
|
3841 ;; Can't return process-result
|
|
|
3842 ;; and process-line since executing
|
|
|
3843 ;; the cont may have changed
|
|
|
3844 ;; the state of the process buffer.
|
|
|
3845 nil
|
|
|
3846 (list efs-process-result
|
|
|
3847 efs-process-result-line
|
|
|
3848 efs-process-result-cont-lines)))
|
|
|
3849
|
|
|
3850 ;; If the process died, the filter would have never got the chance
|
|
|
3851 ;; to call the cont. Try to jump start things.
|
|
|
3852
|
|
|
3853 (if (and (not (memq (process-status proc) '(run open)))
|
|
|
3854 (string-equal efs-process-result-line "")
|
|
|
3855 cont
|
|
|
3856 (equal cont efs-process-continue))
|
|
|
3857 (progn
|
|
|
3858 (setq efs-process-continue nil
|
|
|
3859 efs-process-busy nil)
|
|
|
3860 ;; The process may be in some strange state. Get rid of it.
|
|
|
3861 (condition-case nil (delete-process proc) (error nil))
|
|
|
3862 (efs-call-cont cont 'fatal "" "")))))
|
|
|
3863
|
|
|
3864 (error "FTP process %s has died." (process-name proc))))
|
|
|
3865
|
|
|
3866 (efs-defun efs-quote-string nil (string &optional not-space)
|
|
|
3867 "Quote any characters in STRING that may confuse the ftp process.
|
|
|
3868 If NOT-SPACE is non-nil, then blank characters are not quoted, because
|
|
|
3869 it is assumed that the string will be surrounded by \"'s."
|
|
|
3870 (apply (function concat)
|
|
|
3871 (mapcar (function
|
|
|
3872 (lambda (char)
|
|
|
3873 (if (or (< char ?\ )
|
|
|
3874 (and (null not-space) (= char ?\ ))
|
|
|
3875 (> char ?\~)
|
|
|
3876 (= char ?\")
|
|
|
3877 (= char ?\\))
|
|
|
3878 (vector ?\\ char)
|
|
|
3879 (vector char))))
|
|
|
3880 string)))
|
|
|
3881
|
|
|
3882 (efs-defun efs-fix-path nil (path &optional reverse)
|
|
|
3883 "Convert PATH from a unix format to a non-unix format.
|
|
|
3884 If optional REVERSE, convert in the opposite direction."
|
|
|
3885 (identity path))
|
|
|
3886
|
|
|
3887 (efs-defun efs-fix-dir-path nil (dir-path)
|
|
|
3888 "Convert DIR-PATH from unix format to a non-unix format for a dir listing"
|
|
|
3889 ;; The default def runs for dos-distinct, ka9q, and all the unix's.
|
|
|
3890 ;; To be more careful about distinguishing dirs from plain files,
|
|
|
3891 ;; we append a ".".
|
|
|
3892 (let ((len (length dir-path)))
|
|
|
3893 (if (and (not (zerop len)) (= (aref dir-path (1- len)) ?/))
|
|
|
3894 (concat dir-path ".")
|
|
|
3895 dir-path)))
|
|
|
3896
|
|
|
3897 (defun efs-send-cmd (host user cmd
|
|
|
3898 &optional msg pre-cont cont nowait noretry)
|
|
|
3899 "Find an ftp process connected to HOST logged in as USER and send it CMD.
|
|
|
3900 MSG is an optional status message to be output before and after issuing the
|
|
|
3901 command.
|
|
|
3902
|
|
|
3903 See the documentation for efs-raw-send-cmd for a description of CONT, PRE-CONT
|
|
|
3904 and NOWAIT. Normally, if the command fails it is retried. If NORETRY is
|
|
|
3905 non-nil, this is not done."
|
|
|
3906 ;; Handles conversion to remote pathname syntax and remote ls option
|
|
|
3907 ;; capability. Also, sends umask if nec.
|
|
|
3908
|
|
|
3909 (let ((proc (efs-get-process host user)))
|
|
|
3910
|
|
|
3911 (if (and
|
|
|
3912 (eq nowait t)
|
|
|
3913 (save-excursion
|
|
|
3914 (set-buffer (process-buffer proc))
|
|
|
3915 (or efs-process-busy
|
|
|
3916 efs-process-cmd-waiting)))
|
|
|
3917
|
|
|
3918 (progn
|
|
|
3919 (efs-add-to-queue
|
|
|
3920 host user
|
|
|
3921 ;; Not nec. to store host and user, because the queue is for
|
|
|
3922 ;; a specific host user pair anyway. Because the queue is always
|
|
|
3923 ;; examined when efs-process-busy
|
|
|
3924 ;; is nil, it should be impossible to get into a loop
|
|
|
3925 ;; where we keep re-queueing over and over. To be on the safe
|
|
|
3926 ;; side, store nowait as 1.
|
|
|
3927 (list cmd msg pre-cont cont 1 noretry))
|
|
|
3928 nil)
|
|
|
3929
|
|
|
3930 ;; Send a command.
|
|
|
3931
|
|
|
3932 (let (cmd-string afsc-result afsc-line afsc-cont-lines)
|
|
|
3933
|
|
|
3934 (let ((efs-nested-cmd t)
|
|
|
3935 (cmd0 (car cmd))
|
|
|
3936 (cmd1 (nth 1 cmd))
|
|
|
3937 (cmd2 (nth 2 cmd))
|
|
|
3938 (cmd3 (nth 3 cmd)))
|
|
|
3939
|
|
|
3940 (cond
|
|
|
3941
|
|
|
3942 ((eq cmd0 'quote)
|
|
|
3943 ;; QUOTEd commands
|
|
|
3944 (cond
|
|
|
3945
|
|
|
3946 ((eq cmd1 'site)
|
|
|
3947 ;; SITE commands
|
|
|
3948 (cond
|
|
|
3949 ((memq cmd2 '(umask idle dos exec nfs group gpass))
|
|
|
3950 ;; For UMASK cmd3 = value of umask
|
|
|
3951 ;; For IDLE cmd3 = idle setting, or nil if we're querying.
|
|
|
3952 ;; For DOS and NFS cmd3 is nil.
|
|
|
3953 ;; For EXEC cmd3 is the command to be exec'ed -- a string.
|
|
|
3954 (if cmd3 (setq cmd3 (concat " " cmd3)))
|
|
|
3955 (setq cmd-string (concat "quote site " (symbol-name cmd2)
|
|
|
3956 cmd3)))
|
|
|
3957 ((eq cmd2 'chmod)
|
|
|
3958 (let* ((host-type (efs-host-type host user))
|
|
|
3959 (cmd4 (efs-quote-string
|
|
|
3960 host-type (efs-fix-path host-type (nth 4 cmd)))))
|
|
|
3961 (setq cmd-string (concat "quote site chmod " cmd3 " "
|
|
|
3962 cmd4))))
|
|
|
3963 (t (error "efs: Don't know how to send %s %s %s %s"
|
|
|
3964 cmd0 cmd1 cmd2 cmd3))))
|
|
|
3965
|
|
|
3966 ((memq cmd1 '(pwd xpwd syst pasv noop))
|
|
|
3967 (setq cmd-string (concat "quote " (symbol-name cmd1))))
|
|
|
3968
|
|
|
3969 ;; PORT command (cmd2 is IP + port address)
|
|
|
3970 ((eq cmd1 'port)
|
|
|
3971 (setq cmd-string (concat "quote port " cmd2)))
|
|
|
3972
|
|
|
3973 ((memq cmd1 '(appe retr))
|
|
|
3974 (let ((host-type (efs-host-type host user)))
|
|
|
3975 ;; Set an xfer type
|
|
|
3976 (if cmd3 (efs-set-xfer-type host user cmd3 t))
|
|
|
3977 (setq cmd2 (efs-quote-string host-type
|
|
|
3978 (efs-fix-path host-type cmd2))
|
|
|
3979 cmd-string (concat "quote " (symbol-name cmd1) " "
|
|
|
3980 cmd2))))
|
|
|
3981
|
|
|
3982 ((eq cmd1 'stor)
|
|
|
3983 (let ((host-type (efs-host-type host user)))
|
|
|
3984 (if (memq host-type efs-unix-host-types)
|
|
|
3985 (efs-set-umask host user))
|
|
|
3986 ;; Set an xfer type
|
|
|
3987 (if cmd3 (efs-set-xfer-type host user cmd3 t))
|
|
|
3988 (setq cmd2 (efs-quote-string host-type
|
|
|
3989 (efs-fix-path host-type cmd2))
|
|
|
3990 cmd-string (concat "quote stor " cmd2))))
|
|
|
3991
|
|
|
3992 ((memq cmd1 '(size mdtm rnfr))
|
|
|
3993 (let ((host-type (efs-host-type host user)))
|
|
|
3994 (setq cmd2 (efs-quote-string host-type
|
|
|
3995 (efs-fix-path host-type cmd2))
|
|
|
3996 cmd-string (concat "quote "
|
|
|
3997 (symbol-name cmd1) " " cmd2))))
|
|
|
3998
|
|
|
3999 ((memq cmd1 '(pass user))
|
|
|
4000 (setq cmd-string (concat "quote " (symbol-name cmd1) " " cmd2)))
|
|
|
4001
|
|
|
4002 (t
|
|
|
4003 (error "efs: Don't know how to send %s %s %s %s"
|
|
|
4004 cmd0 cmd1 cmd2 cmd3))))
|
|
|
4005
|
|
|
4006 ;; TYPE command
|
|
|
4007 ((eq cmd0 'type)
|
|
|
4008 (setq cmd-string (concat "type " (symbol-name cmd1))))
|
|
|
4009
|
|
|
4010 ;; DIR command
|
|
|
4011 ;; cmd == 'dir "remote-path" "local-path" "ls-switches"
|
|
|
4012 ((memq cmd0 '(dir nlist))
|
|
|
4013 (let ((host-type (efs-host-type host user))
|
|
|
4014 (listing-type (efs-listing-type host user)))
|
|
|
4015 (setq cmd1 (efs-fix-dir-path host-type cmd1))
|
|
|
4016 (cond
|
|
|
4017 ((memq listing-type efs-nlist-listing-types)
|
|
|
4018 (setq cmd-string (concat efs-nlist-cmd " "
|
|
|
4019 (efs-quote-string host-type cmd1)
|
|
|
4020 " " cmd2)))
|
|
|
4021 ((or (memq host-type efs-dumb-host-types)
|
|
|
4022 (null cmd3))
|
|
|
4023 (setq cmd-string (format "%s %s %s"
|
|
|
4024 (if (eq cmd0 'nlist)
|
|
|
4025 efs-nlist-cmd
|
|
|
4026 "dir")
|
|
|
4027 (efs-quote-string host-type cmd1)
|
|
|
4028 cmd2)))
|
|
|
4029 ((setq cmd-string
|
|
|
4030 (format "%s \"%s %s\" %s"
|
|
|
4031 (if (eq cmd0 'nlist)
|
|
|
4032 efs-nlist-cmd
|
|
|
4033 "ls")
|
|
|
4034 cmd3 (efs-quote-string host-type cmd1 t)
|
|
|
4035 ;; cmd2 is a temp file, not nec. to quote.
|
|
|
4036 cmd2))))))
|
|
|
4037
|
|
|
4038 ;; First argument is the remote pathname
|
|
|
4039 ((memq cmd0 '(delete mkdir rmdir cd))
|
|
|
4040 (let ((host-type (efs-host-type host user)))
|
|
|
4041 (setq cmd1 (efs-quote-string host-type
|
|
|
4042 (efs-fix-path host-type cmd1))
|
|
|
4043 cmd-string (concat (symbol-name cmd0) " " cmd1))))
|
|
|
4044
|
|
|
4045 ;; GET command
|
|
|
4046 ((eq cmd0 'get)
|
|
|
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 t)
|
|
|
4050 (setq cmd1 (efs-quote-string host-type
|
|
|
4051 (efs-fix-path host-type cmd1))
|
|
|
4052 cmd2 (efs-quote-string host-type cmd2)
|
|
|
4053 cmd-string (concat "get " cmd1 " " cmd2))))
|
|
|
4054
|
|
|
4055 ;; PUT command
|
|
|
4056 ((eq cmd0 'put)
|
|
|
4057 (let ((host-type (efs-host-type host user)))
|
|
|
4058 (if (memq host-type efs-unix-host-types)
|
|
|
4059 (efs-set-umask host user))
|
|
|
4060 (if cmd3 (efs-set-xfer-type host user cmd3))
|
|
|
4061 (efs-set-hash-mark-unit host user)
|
|
|
4062 (setq cmd2 (efs-quote-string host-type
|
|
|
4063 (efs-fix-path host-type cmd2))
|
|
|
4064 cmd1 (efs-quote-string host-type cmd1)
|
|
|
4065 cmd-string (concat "put " cmd1 " " cmd2))))
|
|
|
4066
|
|
|
4067 ;; APPEND command
|
|
|
4068 ((eq cmd0 'append)
|
|
|
4069 (let ((host-type (efs-host-type host user)))
|
|
|
4070 (if cmd3 (efs-set-xfer-type host user cmd3))
|
|
|
4071 (efs-set-hash-mark-unit host user)
|
|
|
4072 (setq cmd2 (efs-quote-string host-type
|
|
|
4073 (efs-fix-path host-type cmd2))
|
|
|
4074 cmd1 (efs-quote-string host-type cmd1)
|
|
|
4075 cmd-string (concat "append " cmd1 " " cmd2))))
|
|
|
4076
|
|
|
4077 ;; CHMOD command
|
|
|
4078 ((eq cmd0 'chmod)
|
|
|
4079 (let ((host-type (efs-host-type host user)))
|
|
|
4080 (setq cmd2 (efs-quote-string host-type
|
|
|
4081 (efs-fix-path host-type cmd2))
|
|
|
4082 cmd-string (concat "chmod " cmd1 " " cmd2))))
|
|
|
4083
|
|
|
4084 ;; Both arguments are remote pathnames
|
|
|
4085 ((eq cmd0 'rename)
|
|
|
4086 (let ((host-type (efs-host-type host user)))
|
|
|
4087 (setq cmd1 (efs-quote-string host-type
|
|
|
4088 (efs-fix-path host-type cmd1))
|
|
|
4089 cmd2 (efs-quote-string host-type
|
|
|
4090 (efs-fix-path host-type cmd2))
|
|
|
4091 cmd-string (concat "rename " cmd1 " " cmd2))))
|
|
|
4092
|
|
48
|
4093 ;; passive command
|
|
|
4094 ((eq cmd0 'passive)
|
|
|
4095 (setq cmd-string "passive"))
|
|
|
4096
|
|
22
|
4097 (t
|
|
|
4098 (error "efs: Don't know how to send %s %s %s %s"
|
|
|
4099 cmd0 cmd1 cmd2 cmd3))))
|
|
|
4100
|
|
|
4101 ;; Actually send the resulting command.
|
|
|
4102 ;; Why do we use this complicated binding of afsc-{result,line},
|
|
|
4103 ;; rather then use the fact that efs-raw-send-cmd returns?
|
|
|
4104 ;; Because efs-raw-send-cmd returns the result of the first
|
|
|
4105 ;; attempt only. efs-send-cmd should return the result of
|
|
|
4106 ;; the retry, if one was necessary.
|
|
|
4107 ;; Maybe it would be better if efs-raw-send-cmd returned
|
|
|
4108 ;; the result of cont, if nowait was nil? Or maybe still return
|
|
|
4109 ;; \(result line \)? As long as nowait is nil, it should
|
|
|
4110 ;; return something useful.
|
|
|
4111
|
|
|
4112 ;; Beware, if some of the above FTP commands had to restart
|
|
|
4113 ;; the process, PROC won't be set to the right process object.
|
|
|
4114 (setq proc (efs-get-process host user))
|
|
|
4115
|
|
|
4116 (efs-raw-send-cmd
|
|
|
4117 proc
|
|
|
4118 cmd-string
|
|
|
4119 msg
|
|
|
4120 pre-cont
|
|
|
4121 (efs-cont (result line cont-lines) (host user proc cmd msg pre-cont
|
|
|
4122 cont nowait noretry)
|
|
|
4123 (cond ((and (null noretry) (eq result 'fatal))
|
|
|
4124 (let ((retry
|
|
|
4125 (efs-send-cmd
|
|
|
4126 host user cmd msg pre-cont cont
|
|
|
4127 (if (eq nowait t) 1 nowait) t)))
|
|
|
4128 (or cont nowait
|
|
|
4129 (setq afsc-result (car retry)
|
|
|
4130 afsc-line (nth 1 retry)
|
|
|
4131 afsc-cont-lines (nth 2 retry)))))
|
|
|
4132 ((and (eq result 'failed)
|
|
|
4133 (or (memq (car cmd) '(append rename put))
|
|
|
4134 (and (eq (car cmd) 'quote)
|
|
|
4135 (eq (nth 1 cmd) 'stor)))
|
|
|
4136 (efs-save-match-data
|
|
|
4137 (string-match efs-write-protect-msgs line)))
|
|
|
4138 (let ((retry (efs-write-recover
|
|
|
4139 (efs-host-type host)
|
|
|
4140 line cont-lines host user cmd msg pre-cont
|
|
|
4141 cont nowait noretry)))
|
|
|
4142 (or cont nowait
|
|
|
4143 (setq afsc-result (car retry)
|
|
|
4144 afsc-line (nth 1 retry)
|
|
|
4145 afsc-cont-lines (nth 2 retry)))))
|
|
|
4146
|
|
|
4147 (t (if cont
|
|
|
4148 (efs-call-cont cont result line cont-lines)
|
|
|
4149 (or nowait
|
|
|
4150 (setq afsc-result result
|
|
|
4151 afsc-line line
|
|
|
4152 afsc-cont-lines cont-lines))))))
|
|
|
4153 nowait)
|
|
|
4154
|
|
|
4155 (prog1
|
|
|
4156 (if (or nowait cont)
|
|
|
4157 nil
|
|
|
4158 (list afsc-result afsc-line afsc-cont-lines))
|
|
|
4159
|
|
|
4160 ;; Check the queue
|
|
|
4161 (or nowait
|
|
|
4162 efs-nested-cmd
|
|
|
4163 (let ((buff (efs-ftp-process-buffer host user)))
|
|
|
4164 (if (get-buffer buff)
|
|
|
4165 (save-excursion
|
|
|
4166 (set-buffer buff)
|
|
|
4167 (if efs-process-q
|
|
|
4168 (let ((next (car efs-process-q)))
|
|
|
4169 (setq efs-process-q (cdr efs-process-q))
|
|
|
4170 (apply 'efs-send-cmd host user next))))))))))))
|
|
|
4171
|
|
|
4172 (efs-defun efs-write-recover nil
|
|
|
4173 (line cont-lines host user cmd msg pre-cont cont nowait noretry)
|
|
|
4174 "Called when a write command fails with `efs-write-protect-msgs'.
|
|
|
4175 Should return \(result line cont-lines\), like `efs-raw-send-cmd'."
|
|
|
4176 ;; This default version doesn't do anything.
|
|
|
4177 (if cont
|
|
|
4178 (progn
|
|
|
4179 (efs-call-cont cont 'failed line cont-lines)
|
|
|
4180 nil)
|
|
|
4181 (if nowait nil (list 'failed line cont-lines))))
|
|
|
4182
|
|
|
4183 ;;;; ---------------------------------------------------------------------
|
|
|
4184 ;;;; The login sequence. (The follows RFC959 rather tightly. If a server
|
|
|
4185 ;;;; can't even get the login codes right, it is
|
|
|
4186 ;;;; pretty much scrap metal.)
|
|
|
4187 ;;;; ---------------------------------------------------------------------
|
|
|
4188
|
|
40
|
4189 ;;;###autoload
|
|
22
|
4190 (defun efs-nslookup-host (host)
|
|
|
4191 "Attempt to resolve the given HOSTNAME using nslookup if possible."
|
|
|
4192 (interactive "sHost: ")
|
|
|
4193 (if efs-nslookup-program
|
|
|
4194 (let* ((default-directory exec-directory)
|
|
|
4195 (default-major-mode 'fundamental-mode)
|
|
|
4196 (process-connection-type nil)
|
|
|
4197 (proc (start-process " *nslookup*" " *nslookup*"
|
|
|
4198 efs-nslookup-program host))
|
|
|
4199 (res host))
|
|
|
4200 (process-kill-without-query proc)
|
|
|
4201 (save-excursion
|
|
|
4202 (set-buffer (process-buffer proc))
|
|
|
4203 (let ((quit-flag nil)
|
|
|
4204 (inhibit-quit nil))
|
|
|
4205 (while (memq (process-status proc) '(run open))
|
|
|
4206 (accept-process-output proc)))
|
|
|
4207 (goto-char (point-min))
|
|
|
4208 (if (re-search-forward
|
|
|
4209 "Name:.*\nAddress\\(es\\)?: *\\([.0-9]+\\)$" nil t)
|
|
|
4210 (setq res (buffer-substring (match-beginning 2)
|
|
|
4211 (match-end 2))))
|
|
|
4212 (kill-buffer (current-buffer)))
|
|
|
4213 (if (interactive-p)
|
|
|
4214 (message "%s: %s" host res))
|
|
|
4215 res)
|
|
|
4216 (if (interactive-p)
|
|
|
4217 (message
|
|
|
4218 "No nslookup program. See the variable efs-nslookup-program."))
|
|
|
4219 host))
|
|
|
4220
|
|
|
4221 (defun efs-login (host user proc)
|
|
|
4222 "Connect to the FTP-server on HOST as USER.
|
|
|
4223 PROC is the process to the FTP-client. Doesn't call efs-save-match-data.
|
|
|
4224 You must do that yourself."
|
|
|
4225 (let ((gate (efs-use-gateway-p host)))
|
|
|
4226 (if (eq gate 'kerberos)
|
|
|
4227 (progn
|
|
|
4228 (setq proc (efs-kerberos-login host user proc))
|
|
|
4229 (efs-login-send-user host user proc gate))
|
|
48
|
4230 (let ((to (if (memq gate '(proxy raptor))
|
|
22
|
4231 efs-gateway-host
|
|
|
4232 host))
|
|
|
4233 port cmd result)
|
|
|
4234 (if (string-match "#" to)
|
|
|
4235 (setq port (substring to (match-end 0))
|
|
|
4236 to (substring to 0 (match-beginning 0))))
|
|
|
4237 (and efs-nslookup-on-connect
|
|
|
4238 (string-match "[^0-9.]" to)
|
|
|
4239 (setq to (efs-nslookup-host to)))
|
|
|
4240 (setq cmd (concat "open " to))
|
|
|
4241 (if port (setq cmd (concat cmd " " port)))
|
|
|
4242
|
|
|
4243 ;; Send OPEN command.
|
|
|
4244 (setq result (efs-raw-send-cmd proc cmd nil))
|
|
|
4245
|
|
|
4246 (and (eq gate 'interlock) (string-match "^331 " (nth 1 result))
|
|
|
4247 (setq result (efs-login-send-pass
|
|
|
4248 efs-gateway-host
|
|
|
4249 (efs-get-user efs-gateway-host) proc)))
|
|
|
4250
|
|
|
4251 ;; Analyze result of OPEN.
|
|
|
4252 (if (car result)
|
|
|
4253 (progn
|
|
|
4254 (condition-case nil (delete-process proc) (error nil))
|
|
|
4255 (efs-error host user (concat "OPEN request failed: "
|
|
|
4256 (nth 1 result))))
|
|
|
4257 (efs-login-send-user host user proc gate))))))
|
|
|
4258
|
|
|
4259 (defun efs-login-send-user (host user proc &optional gate retry)
|
|
|
4260 "Send user command to HOST and USER. PROC is the ftp client process.
|
|
|
4261 Optional argument GATE specifies which type of gateway is being used.
|
|
|
4262 RETRY argument specifies to try twice if we get a 421 response."
|
|
|
4263 (let ((cmd (cond
|
|
48
|
4264 ((memq gate '(proxy interlock))
|
|
22
|
4265 (format "quote USER \"%s\"@%s" user
|
|
|
4266 (if (and efs-nslookup-on-connect
|
|
|
4267 (string-match "[^0-9.]" host))
|
|
|
4268 (efs-nslookup-host host)
|
|
|
4269 host)))
|
|
|
4270 ((eq gate 'raptor)
|
|
|
4271 (format "quote USER \"%s\"@%s %s" user
|
|
|
4272 (if (and efs-nslookup-on-connect
|
|
|
4273 (string-match "[^0-9.]" host))
|
|
|
4274 (efs-nslookup-host host)
|
|
|
4275 host)
|
|
|
4276 (nth 3 efs-gateway-type)))
|
|
|
4277 ((eq gate 'kerberos)
|
|
|
4278 (let ((to host)
|
|
|
4279 port)
|
|
|
4280 (if (string-match "#" host)
|
|
|
4281 (progn
|
|
|
4282 (setq to (substring host 0 (match-beginning 0))
|
|
|
4283 port (substring host (match-end 0)))
|
|
|
4284 (and efs-nslookup-on-connect
|
|
|
4285 (string-match "[^0-9.]" to)
|
|
|
4286 (efs-nslookup-host to))
|
|
|
4287 (setq to (concat to "@" port))))
|
|
|
4288 (format "quote user \"%s\"@%s" user to)))
|
|
|
4289 (t
|
|
|
4290 (format "quote user \"%s\"" user))))
|
|
|
4291 (msg (format "Logging in as user %s%s..." user
|
|
48
|
4292 (if (memq gate '(proxy raptor kerberos))
|
|
22
|
4293 (concat "@" host) "")))
|
|
|
4294 result code)
|
|
|
4295
|
|
|
4296 ;; Send the message by hand so that we can report on the size
|
|
|
4297 ;; of the MOTD.
|
|
|
4298 (message msg)
|
|
|
4299
|
|
|
4300 ;; Send USER command.
|
|
|
4301 (setq result (efs-raw-send-cmd proc cmd nil))
|
|
|
4302
|
|
|
4303 ;; Analyze result of USER (this follows RFC959 strictly)
|
|
|
4304 (if (< (length (nth 1 result)) 4)
|
|
|
4305 (progn
|
|
|
4306 (condition-case nil (delete-process proc) (error nil))
|
|
|
4307 (efs-error host user
|
|
|
4308 (concat "USER request failed: " (nth 1 result))))
|
|
|
4309
|
|
|
4310 (setq code (substring (nth 1 result) 0 4))
|
|
|
4311 (cond
|
|
|
4312
|
|
|
4313 ((string-equal "331 " code)
|
|
|
4314 ;; Need password
|
|
|
4315 (setq result (efs-login-send-pass host user proc gate)))
|
|
|
4316
|
|
|
4317 ((string-equal "332 " code)
|
|
|
4318 ;; Need an account, but no password
|
|
|
4319 (setq result (efs-login-send-acct host user proc gate)))
|
|
|
4320
|
|
|
4321 ((null (car result))
|
|
|
4322 ;; logged in proceed
|
|
|
4323 nil)
|
|
|
4324
|
|
|
4325 ((and (or (string-equal "530 " code) (string-equal "421 " code))
|
|
|
4326 (efs-anonymous-p user)
|
|
|
4327 (or (string-match efs-too-many-users-msgs (nth 1 result))
|
|
|
4328 (string-match efs-too-many-users-msgs (nth 2 result))))
|
|
|
4329 (if (save-window-excursion
|
|
|
4330 (condition-case nil
|
|
|
4331 (display-buffer (process-buffer proc))
|
|
|
4332 (error nil))
|
|
|
4333 (y-or-n-p (format
|
|
|
4334 "Too many users for %s@%s. Try again? "
|
|
|
4335 user host)))
|
|
|
4336 (progn
|
|
|
4337 ;; Set result to nil if we are doing a retry, so done
|
|
|
4338 ;; message only gets sent once.
|
|
|
4339 (setq result nil)
|
|
|
4340 (if (string-equal code "530 ")
|
|
|
4341 (efs-login-send-user host user proc gate t)
|
|
|
4342 (efs-get-process host user)))
|
|
|
4343 (signal 'quit nil)))
|
|
|
4344
|
|
|
4345 ((and retry (string-equal code "421 "))
|
|
|
4346 (setq result nil)
|
|
|
4347 (efs-get-process host user))
|
|
|
4348
|
|
|
4349 (t ; bombed
|
|
|
4350 (condition-case nil (delete-process proc) (error nil))
|
|
|
4351 ;; Wrong username?
|
|
|
4352 (efs-set-user host nil)
|
|
|
4353 (efs-error host user
|
|
|
4354 (concat "USER request failed: " (nth 1 result)))))
|
|
|
4355 (and (null (car result))
|
|
|
4356 (stringp (nth 2 result))
|
|
|
4357 (message "%sdone%s" msg
|
|
|
4358 (let ((n (efs-occur-in-string ?\n (nth 2 result))))
|
|
|
4359 (if (> n 1)
|
|
|
4360 (format "; MOTD of %d lines" n)
|
|
|
4361 "")))))))
|
|
|
4362
|
|
|
4363 (defun efs-login-send-pass (host user proc &optional gate)
|
|
|
4364 "Sends password to HOST and USER. PROC is the ftp client process.
|
|
|
4365 Doesn't call efs-save-match data. You must do that yourself."
|
|
|
4366 ;; Note that efs-get-password always returns something.
|
|
|
4367 ;; It prompts the user if necessary. Even if the returned password is
|
|
|
4368 ;; \"\", send it, because we wouldn't be running this function
|
|
|
4369 ;; if the server wasn't insisting on a password.
|
|
|
4370 (let* ((pass "")
|
|
|
4371 (qpass "")
|
|
|
4372 (cmd "")
|
|
|
4373 (result (unwind-protect
|
|
|
4374 (progn
|
|
|
4375 (condition-case nil
|
|
|
4376 (setq pass (efs-get-passwd host user))
|
|
|
4377 (quit (condition-case nil
|
|
|
4378 (kill-buffer (process-buffer proc))
|
|
|
4379 (error nil))
|
|
|
4380 (signal 'quit nil)))
|
|
|
4381 (setq cmd (concat
|
|
|
4382 "quote pass "
|
|
|
4383 (setq qpass (efs-quote-string nil pass t))))
|
|
|
4384 (efs-raw-send-cmd proc cmd))
|
|
|
4385 (fillarray pass 0)
|
|
|
4386 (fillarray qpass 0)
|
|
|
4387 (fillarray cmd 0)))
|
|
|
4388 (code (and (>= (length (nth 1 result)) 4)
|
|
|
4389 (substring (nth 1 result) 0 4))))
|
|
|
4390 (or code (setq code ""))
|
|
|
4391 ;; Analyze the result.
|
|
|
4392 (cond
|
|
|
4393 ((string-equal code "332 ")
|
|
|
4394 ;; require an account passwd
|
|
|
4395 (setq result (efs-login-send-acct host user proc gate)))
|
|
|
4396 ((null (car result))
|
|
|
4397 ;; logged in proceed
|
|
|
4398 nil)
|
|
|
4399 ((or (string-equal code "530 ") (string-equal code "421 "))
|
|
|
4400 ;; Give the user another chance
|
|
|
4401 (condition-case nil
|
|
|
4402 (if (efs-anonymous-p user)
|
|
|
4403 (if (or (string-match efs-too-many-users-msgs (nth 1 result))
|
|
|
4404 (string-match efs-too-many-users-msgs (nth 2 result)))
|
|
|
4405 (if (save-window-excursion
|
|
|
4406 (condition-case nil
|
|
|
4407 (display-buffer (process-buffer proc))
|
|
|
4408 (error nil))
|
|
|
4409 (y-or-n-p (format
|
|
|
4410 "Too many users for %s@%s. Try again? "
|
|
|
4411 user host)))
|
|
|
4412 (progn
|
|
|
4413 ;; Return nil if we are doing a retry, so done
|
|
|
4414 ;; message only gets sent once.
|
|
|
4415 (setq result nil)
|
|
|
4416 (if (string-equal code "530 ")
|
|
|
4417 (efs-login-send-user host user proc gate)
|
|
|
4418 (efs-get-process host user)))
|
|
|
4419 (signal 'quit nil))
|
|
|
4420 (unwind-protect
|
|
|
4421 (efs-set-passwd
|
|
|
4422 host user
|
|
|
4423 (save-window-excursion
|
|
|
4424 (condition-case nil
|
|
|
4425 (display-buffer (process-buffer proc))
|
|
|
4426 (error nil))
|
|
|
4427 (setq pass
|
|
|
4428 (read-passwd
|
|
|
4429 (format
|
|
|
4430 "Password for %s@%s failed. Try again: "
|
|
|
4431 user host)))))
|
|
|
4432 (fillarray pass 0))
|
|
|
4433 (setq result nil)
|
|
|
4434 (efs-login-send-user host user proc gate))
|
|
|
4435 (unwind-protect
|
|
|
4436 (efs-set-passwd
|
|
|
4437 host user
|
|
|
4438 (setq pass
|
|
|
4439 (read-passwd
|
|
|
4440 (format "Password for %s@%s failed. Try again: "
|
|
|
4441 user host))))
|
|
|
4442 (fillarray pass 0))
|
|
|
4443 (setq result nil)
|
|
|
4444 (efs-login-send-user host user proc gate))
|
|
|
4445 (quit (condition-case nil (delete-process proc) (error nil))
|
|
|
4446 (efs-set-user host nil)
|
|
|
4447 (efs-set-passwd host user nil)
|
|
|
4448 (signal 'quit nil))
|
|
|
4449 (error (condition-case nil (delete-process proc) (error nil))
|
|
|
4450 (efs-set-user host nil)
|
|
|
4451 (efs-set-passwd host user nil)
|
|
|
4452 (efs-error host user "PASS request failed."))))
|
|
|
4453 (t ; bombed for unexplained reasons
|
|
|
4454 (condition-case nil (delete-process proc) (error nil))
|
|
|
4455 (efs-error host user (concat "PASS request failed: " (nth 1 result)))))
|
|
|
4456 result))
|
|
|
4457
|
|
|
4458 (defun efs-login-send-acct (host user proc &optional gate)
|
|
|
4459 "Sends account password to HOST and USER. PROC is the ftp client process.
|
|
|
4460 Doesn't call efs-save-match data. You must do that yourself."
|
|
|
4461 (let* ((acct "")
|
|
|
4462 (qacct "")
|
|
|
4463 (cmd "")
|
|
|
4464 (result (unwind-protect
|
|
|
4465 (progn
|
|
|
4466 ;; The raptor gateway requires us to send a gateway
|
|
|
4467 ;; authentication password for account. What if the
|
|
|
4468 ;; remote server wants one too?
|
|
|
4469 (setq acct (if (eq gate 'raptor)
|
|
|
4470 (efs-get-account
|
|
|
4471 efs-gateway-host
|
|
|
4472 (nth 3 efs-gateway-type) nil t)
|
|
|
4473 (efs-get-account host user nil t))
|
|
|
4474 qacct (efs-quote-string nil acct t)
|
|
|
4475 cmd (concat "quote acct " qacct))
|
|
|
4476 (efs-raw-send-cmd proc cmd))
|
|
|
4477 (fillarray acct 0)
|
|
|
4478 (fillarray qacct 0)
|
|
|
4479 (fillarray cmd 0))))
|
|
|
4480 ;; Analyze the result
|
|
|
4481 (cond
|
|
|
4482 ((null (car result))
|
|
|
4483 ;; logged in proceed
|
|
|
4484 nil)
|
|
|
4485 ((eq (car result) 'failed)
|
|
|
4486 ;; Give the user another chance
|
|
|
4487 (condition-case nil
|
|
|
4488 (progn
|
|
|
4489 (unwind-protect
|
|
|
4490 (progn
|
|
|
4491 (setq acct (read-passwd
|
|
|
4492 (format
|
|
|
4493 "Account password for %s@%s failed. Try again: "
|
|
|
4494 user host)))
|
|
|
4495 (or (and efs-high-security-hosts
|
|
|
4496 (string-match efs-high-security-hosts
|
|
|
4497 (format "%s@%s" user host)))
|
|
|
4498 (efs-set-account host user nil acct)))
|
|
|
4499 (fillarray acct 0))
|
|
|
4500 (setq result (efs-login-send-user host user proc gate)))
|
|
|
4501 (quit (condition-case nil (delete-process proc) (error nil)))
|
|
|
4502 (error (condition-case nil (delete-process proc) (error nil))
|
|
|
4503 (efs-error host user "ACCT request failed."))))
|
|
|
4504 (t ; bombed for unexplained reasons
|
|
|
4505 (condition-case nil (delete-process proc) (error nil))
|
|
|
4506 (efs-error host user (concat "ACCT request failed: " (nth 1 result)))))
|
|
|
4507 result))
|
|
|
4508
|
|
|
4509 ;;;; ----------------------------------------------------------------------
|
|
|
4510 ;;;; Changing working directory.
|
|
|
4511 ;;;; ----------------------------------------------------------------------
|
|
|
4512
|
|
|
4513 (defun efs-raw-send-cd (host user dir &optional no-error)
|
|
|
4514 ;; If NO-ERROR, doesn't barf, but just returns success (t) or failure (nil).
|
|
|
4515 ;; This does not use efs-send-cmd.
|
|
|
4516 ;; Also DIR must be in the syntax of the remote host-type.
|
|
|
4517 (let* ((cmd (concat "cd " dir))
|
|
|
4518 cd-result cd-line)
|
|
|
4519 (efs-raw-send-cmd
|
|
|
4520 (efs-get-process host user)
|
|
|
4521 cmd nil nil
|
|
|
4522 (efs-cont (result line cont-lines) (cmd)
|
|
|
4523 (if (eq result 'fatal)
|
|
|
4524 (efs-raw-send-cmd
|
|
|
4525 (efs-get-process host user)
|
|
|
4526 cmd nil nil
|
|
|
4527 (function (lambda (result line cont-lines)
|
|
|
4528 (setq cd-result result
|
|
|
4529 cd-line line))))
|
|
|
4530 (setq cd-result result
|
|
|
4531 cd-line line))))
|
|
|
4532 (if no-error
|
|
|
4533 (null cd-result)
|
|
|
4534 (if cd-result
|
|
|
4535 (efs-error host user (concat "CD failed: " cd-line))))))
|
|
|
4536
|
|
|
4537 ;;;; --------------------------------------------------------------
|
|
|
4538 ;;;; Getting a PWD.
|
|
|
4539 ;;;; --------------------------------------------------------------
|
|
|
4540
|
|
|
4541 (defun efs-unquote-quotes (string)
|
|
|
4542 ;; Unquote \"\"'s in STRING to \".
|
|
|
4543 (let ((start 0)
|
|
|
4544 new)
|
|
|
4545 (while (string-match "\"\"" string start)
|
|
|
4546 (setq new (concat new (substring
|
|
|
4547 string start (1+ (match-beginning 0))))
|
|
|
4548 start (match-end 0)))
|
|
|
4549 (if new
|
|
|
4550 (concat new (substring string start))
|
|
|
4551 string)))
|
|
|
4552
|
|
|
4553 (efs-defun efs-send-pwd nil (host user &optional xpwd)
|
|
|
4554 "Attempts to get the current working directory for the given HOST/USER pair.
|
|
|
4555 Returns \( DIR . LINE \) where DIR is either the directory or NIL if not found,
|
|
|
4556 and LINE is the relevant success or fail line from the FTP-server. If the
|
|
|
4557 optional arg XPWD is given, uses this server command instead of PWD."
|
|
|
4558 (let* ((result (efs-send-cmd host user
|
|
|
4559 (list 'quote (if xpwd 'xpwd 'pwd))
|
|
|
4560 "Getting pwd"))
|
|
|
4561 (line (nth 1 result))
|
|
|
4562 dir)
|
|
|
4563 (or (car result)
|
|
|
4564 (efs-save-match-data
|
|
|
4565 (if (string-match "\"\\(.*\\)\"[^\"]*$" line)
|
|
|
4566 (setq dir (efs-unquote-quotes (substring line (match-beginning 1)
|
|
|
4567 (match-end 1))))
|
|
|
4568 (if (string-match " \\([^ ]+\\) " line) ; stone-age servers!
|
|
|
4569 (setq dir (substring line
|
|
|
4570 (match-beginning 1)
|
|
|
4571 (match-end 1)))))))
|
|
|
4572 (cons dir line)))
|
|
|
4573
|
|
|
4574 (efs-defun efs-send-pwd super-dumb-unix (host user &optional xpwd)
|
|
|
4575 ;; Guess at the pwd for a unix host that doesn't support pwd.
|
|
|
4576 (if (efs-anonymous-p user)
|
|
|
4577 ;; guess
|
|
|
4578 (cons "/" "")
|
|
|
4579 ;; Who knows?
|
|
|
4580 (message "Can't obtain pwd for %s" host)
|
|
|
4581 (ding)
|
|
|
4582 (sleep-for 2)
|
|
|
4583 (message "All file names must be specified as full paths.")
|
|
|
4584 (cons nil "")))
|
|
|
4585
|
|
|
4586 ;;;; --------------------------------------------------------
|
|
|
4587 ;;;; Getting the SIZE of a remote file.
|
|
|
4588 ;;;; --------------------------------------------------------
|
|
|
4589
|
|
|
4590 (defun efs-send-size (host user file)
|
|
|
4591 "For HOST and USER, get the size of FILE in bytes.
|
|
|
4592 This returns a list \( SIZE . LINE \), where SIZE is the file size in bytes,
|
|
|
4593 or nil if this couldn't be determined, and LINE is the output line of the
|
|
|
4594 FTP server."
|
|
|
4595 (efs-save-match-data
|
|
|
4596 (let ((result (efs-send-cmd host user (list 'quote 'size file))))
|
|
|
4597 (setcar result
|
|
|
4598 (and (null (car result))
|
|
|
4599 (string-match "^213 +\\([0-9]+\\)$" (nth 1 result))
|
|
|
4600 (string-to-int
|
|
|
4601 (substring
|
|
|
4602 (cdr result)
|
|
|
4603 (match-beginning 1) (match-end 1)))))
|
|
|
4604 result)))
|
|
|
4605
|
|
|
4606 ;;;; ------------------------------------------------------------
|
|
|
4607 ;;;; umask support
|
|
|
4608 ;;;; ------------------------------------------------------------
|
|
|
4609
|
|
|
4610 (defun efs-umask (user)
|
|
|
4611 "Returns the umask that efs will use for USER.
|
|
|
4612 If USER is root or anonymous, then the values of efs-root-umask
|
|
|
4613 and efs-anonymous-umask, respectively, take precedence, to be followed
|
|
|
4614 by the value of efs-umask, and if this is nil, it returns your current
|
|
|
4615 umask on the local machine. Returns nil if this can't be determined."
|
|
|
4616 (or
|
|
|
4617 (and (string-equal user "root") efs-root-umask)
|
|
|
4618 (and (efs-anonymous-p user)
|
|
|
4619 efs-anonymous-umask)
|
|
|
4620 efs-umask
|
|
|
4621 (let* ((shell (or (and (boundp 'explicit-shell-file-name)
|
|
|
4622 explicit-shell-file-name)
|
|
|
4623 (getenv "ESHELL")
|
|
|
4624 (getenv "SHELL")
|
|
|
4625 "/bin/sh"))
|
|
|
4626 (default-major-mode 'fundamental-mode)
|
|
|
4627 (default-directory exec-directory)
|
|
|
4628 (buff (get-buffer-create " *efs-umask-data*")))
|
|
|
4629 (unwind-protect
|
|
|
4630 (save-excursion
|
|
|
4631 (set-buffer buff)
|
|
|
4632 (call-process shell nil buff nil "-c" "umask")
|
|
|
4633 (goto-char (point-min))
|
|
|
4634 (if (re-search-forward "[0-7]?[0-7]?[0-7]" nil t)
|
|
|
4635 (string-to-int (buffer-substring (match-beginning 0)
|
|
|
4636 (match-end 0)))))
|
|
|
4637 (kill-buffer buff)))))
|
|
|
4638
|
|
|
4639 (defun efs-send-umask (host user mask)
|
|
|
4640 "Sets the umask on HOST for USER to MASK.
|
|
|
4641 Returns t for success, nil for failure."
|
|
|
4642 (interactive
|
|
|
4643 (let* ((path (or buffer-file-name
|
|
|
4644 (and (eq major-mode 'dired-mode)
|
|
|
4645 dired-directory)))
|
|
|
4646 (parsed (and path (efs-ftp-path path)))
|
|
|
4647 (default-host (car parsed))
|
|
|
4648 (default-user (nth 1 parsed))
|
|
|
4649 (default-mask (efs-umask default-user)))
|
|
|
4650 (list
|
|
|
4651 (read-string "Host: " default-host)
|
|
|
4652 (read-string "User: " default-user)
|
|
|
4653 (read-string "Umask: " (int-to-string default-mask)))))
|
|
|
4654 (let (int-mask)
|
|
|
4655 (if (integerp mask)
|
|
|
4656 (setq int-mask mask
|
|
|
4657 mask (int-to-string mask))
|
|
|
4658 (setq int-mask (string-to-int mask)))
|
|
|
4659 (or (string-match "^ *[0-7]?[0-7]?[0-7] *$" mask)
|
|
|
4660 (error "Invalid umask %s" mask))
|
|
|
4661 (efs-send-cmd host user
|
|
|
4662 (list 'quote 'site 'umask mask)
|
|
|
4663 (concat "Setting umask to " mask)
|
|
|
4664 (list
|
|
|
4665 (function
|
|
|
4666 (lambda (int-mask)
|
|
|
4667 (let ((buff (efs-ftp-process-buffer host user)))
|
|
|
4668 (if (get-buffer buff)
|
|
|
4669 (save-excursion
|
|
|
4670 (set-buffer buff)
|
|
|
4671 (setq efs-process-umask int-mask))))))
|
|
|
4672 int-mask)
|
|
|
4673 (efs-cont (result line cont-lines) (host user mask)
|
|
|
4674 (if result
|
|
|
4675 (let ((buff (efs-ftp-process-buffer host user)))
|
|
|
4676 (efs-set-host-property host 'umask-failed t)
|
|
|
4677 (if (get-buffer buff)
|
|
|
4678 (save-excursion
|
|
|
4679 (set-buffer buff)
|
|
|
4680 (setq efs-process-umask nil)))
|
|
|
4681 (message
|
|
|
4682 "Unable to set umask to %s on %s" mask host)
|
|
|
4683 (if efs-ding-on-umask-failure
|
|
|
4684 (progn
|
|
|
4685 (ding)
|
|
|
4686 (sit-for 1))))))
|
|
|
4687 0))) ; Do this NOWAIT = 0
|
|
|
4688
|
|
|
4689 (defun efs-set-umask (host user)
|
|
|
4690 "Sets the umask for HOST and USER, if it has not already been set."
|
|
|
4691 (save-excursion
|
|
|
4692 (set-buffer (process-buffer (efs-get-process host user)))
|
|
|
4693 (if (or efs-process-umask (efs-get-host-property host 'umask-failed))
|
|
|
4694 nil
|
|
|
4695 (let ((umask (efs-umask user)))
|
|
|
4696 (efs-send-umask host user umask)
|
|
|
4697 t)))) ; Tell the caller that we did something.
|
|
|
4698
|
|
|
4699 (defun efs-modes-from-umask (umask)
|
|
|
4700 ;; Given the 3 digit octal integer umask, returns the decimal integer
|
|
|
4701 ;; according to chmod that a file would be written with.
|
|
|
4702 ;; Assumes only ordinary files, so ignores x bits.
|
|
|
4703 (let* ((others (% umask 10))
|
|
|
4704 (umask (/ umask 10))
|
|
|
4705 (group (% umask 10))
|
|
|
4706 (umask (/ umask 10))
|
|
|
4707 (owner (% umask 10))
|
|
|
4708 (factor 1))
|
|
|
4709 (apply '+
|
|
|
4710 (mapcar
|
|
|
4711 (function
|
|
|
4712 (lambda (x)
|
|
|
4713 (prog1
|
|
|
4714 (* factor (- 6 (- x (% x 2))))
|
|
|
4715 (setq factor (* factor 8)))))
|
|
|
4716 (list others group owner)))))
|
|
|
4717
|
|
|
4718 ;;;; ------------------------------------------------------------
|
|
|
4719 ;;;; Idle time manipulation.
|
|
|
4720 ;;;; ------------------------------------------------------------
|
|
|
4721
|
|
|
4722 (defun efs-check-idle (host user)
|
|
|
4723 ;; We just toss it in the queue to run whenever there's time.
|
|
|
4724 ;; Just fail quietly if this doesn't work.
|
|
|
4725 (if (and (or efs-maximize-idle efs-expire-ftp-buffers)
|
|
|
4726 (memq (efs-host-type host) efs-idle-host-types)
|
|
|
4727 (null (efs-get-host-property host 'idle-failed)))
|
|
|
4728 (let ((buffname (efs-ftp-process-buffer host user)))
|
|
|
4729 (efs-add-to-queue
|
|
|
4730 host user
|
|
|
4731 (list '(quote site idle)
|
|
|
4732 nil nil
|
|
|
4733 (efs-cont (result line cont-lines) (host user buffname)
|
|
|
4734 (efs-save-match-data
|
|
|
4735 (if (and (null result)
|
|
|
4736 (string-match efs-idle-msgs line))
|
|
|
4737 (let ((max (substring line (match-beginning 2)
|
|
|
4738 (match-end 2))))
|
|
|
4739 (if (get-buffer buffname)
|
|
|
4740 (save-excursion
|
|
|
4741 (set-buffer buffname)
|
|
|
4742 (setq efs-process-idle-time
|
|
|
4743 (string-to-int
|
|
|
4744 (substring line (match-beginning 1)
|
|
|
4745 (match-end 1))))))
|
|
|
4746 (if (and efs-maximize-idle
|
|
|
4747 (not (efs-anonymous-p user)))
|
|
|
4748 (efs-add-to-queue
|
|
|
4749 host user
|
|
|
4750 (list
|
|
|
4751 (list 'quote 'site 'idle max)
|
|
|
4752 nil nil
|
|
|
4753 (efs-cont (result line cont-lines) (buffname
|
|
|
4754 max)
|
|
|
4755 (and (null result)
|
|
|
4756 (get-buffer buffname)
|
|
|
4757 (save-excursion
|
|
|
4758 (set-buffer buffname)
|
|
|
4759 (setq efs-process-idle-time
|
|
|
4760 (string-to-int max)))))
|
|
|
4761 0))))
|
|
|
4762 (efs-set-host-property host 'idle-failed t))))
|
|
|
4763 0 nil))))) ; Using NOWAIT = 0 inhibits mode line toggling.
|
|
|
4764
|
|
|
4765
|
|
|
4766 ;;;; ------------------------------------------------------------
|
|
|
4767 ;;;; Sending the SYST command for system type.
|
|
|
4768 ;;;; ------------------------------------------------------------
|
|
|
4769
|
|
|
4770 (defun efs-get-syst (host user)
|
|
|
4771 "Use SYST to get the remote system type.
|
|
|
4772 Returns the system type as a string if this succeeds, otherwise nil."
|
|
|
4773 (let* ((result (efs-send-cmd host user '(quote syst)))
|
|
|
4774 (line (nth 1 result)))
|
|
|
4775 (efs-save-match-data
|
|
|
4776 (and (null (car result))
|
|
|
4777 (string-match efs-syst-msgs line)
|
|
|
4778 (substring line (match-end 0))))))
|
|
|
4779
|
|
|
4780 ;;;; ------------------------------------------------------------
|
|
|
4781 ;;;; File transfer representation type support
|
|
|
4782 ;;;; ------------------------------------------------------------
|
|
|
4783
|
|
|
4784 ;;; Legal representation types are: image, ascii, ebcdic, tenex
|
|
|
4785
|
|
|
4786 (efs-defun efs-file-type nil (path)
|
|
|
4787 ;; Returns the file type for PATH, the full efs path, with filename FILE.
|
|
|
4788 ;; The return value is one of 'text, '8-binary, or '36-binary.
|
|
|
4789 (let ((parsed (efs-ftp-path path)))
|
|
|
4790 (efs-save-match-data
|
|
|
4791 (cond
|
|
|
4792 ;; There is no special significance to temp names, but we assume that
|
|
|
4793 ;; they exist on an 8-bit byte machine.
|
|
|
4794 ((or (null path)
|
|
|
4795 (let ((temp (intern-soft path efs-tmp-name-obarray)))
|
|
|
4796 (and temp (memq temp efs-tmp-name-files))))
|
|
|
4797 '8-binary)
|
|
|
4798 ((and (null parsed) (file-exists-p path))
|
|
|
4799 (efs-local-file-type path))
|
|
|
4800 ;; test special hosts
|
|
|
4801 ((and parsed
|
|
|
4802 efs-binary-file-host-regexp
|
|
|
4803 (let ((case-fold-search t))
|
|
|
4804 (string-match efs-binary-file-host-regexp (car parsed))))
|
|
|
4805 '8-binary)
|
|
|
4806 (t
|
|
|
4807 ;; Test file names
|
|
|
4808 (let ((file (efs-internal-file-name-nondirectory
|
|
|
4809 (or (nth 2 parsed) path))))
|
|
|
4810 (cond
|
|
|
4811 ;; test for PDP-10 binaries
|
|
|
4812 ((and efs-36-bit-binary-file-name-regexp
|
|
|
4813 (string-match efs-36-bit-binary-file-name-regexp file))
|
|
|
4814 '36-binary)
|
|
|
4815 ((and efs-binary-file-name-regexp
|
|
|
4816 (string-match efs-binary-file-name-regexp file))
|
|
|
4817 '8-binary)
|
|
|
4818 ((and efs-text-file-name-regexp
|
|
|
4819 (string-match efs-text-file-name-regexp file))
|
|
|
4820 'text)
|
|
|
4821 ;; by default
|
|
|
4822 (t
|
|
|
4823 '8-binary))))))))
|
|
|
4824
|
|
|
4825 (efs-define-fun efs-local-file-type (file)
|
|
|
4826 ;; Looks at the beginning (magic-cookie) of a local file to determine
|
|
|
4827 ;; if it is a text file or not. If it's not a text file, it doesn't care
|
|
|
4828 ;; about what type of binary file, so this doesn't really look for a magic
|
|
|
4829 ;; cookie.
|
|
|
4830 ;; Doesn't call efs-save-match-data. The caller should do so.
|
|
|
4831 (save-excursion
|
|
|
4832 (set-buffer (get-buffer-create efs-data-buffer-name))
|
|
|
4833 (erase-buffer)
|
|
|
4834 (insert-file-contents file nil 0 16)
|
|
|
4835 (if (looking-at "[ -~\n\r\C-L]*\\'")
|
|
|
4836 'text
|
|
|
4837 '8-binary)))
|
|
|
4838
|
|
|
4839 (defun efs-rationalize-file-type (f-type t-type)
|
|
|
4840 ;; When the original and new names for a file indicate
|
|
|
4841 ;; different file types, this function applies an ad hoc heuristic
|
|
|
4842 ;; to return a single file type.
|
|
|
4843 (cond
|
|
|
4844 ((eq f-type t-type)
|
|
|
4845 f-type)
|
|
|
4846 ((memq '36-binary (list f-type t-type))
|
|
|
4847 '36-binary)
|
|
|
4848 ((memq '8-binary (list f-type t-type))
|
|
|
4849 '8-binary)
|
|
|
4850 (t
|
|
|
4851 'text)))
|
|
|
4852
|
|
|
4853 (defun efs-prompt-for-transfer-type (arg)
|
|
|
4854 "Toggles value of efs-prompt-for-transfer-type.
|
|
|
4855 With prefix arg, turns prompting on if arg is positive, otherwise turns
|
|
|
4856 prompting off."
|
|
|
4857 (interactive "P")
|
|
|
4858 (if (if arg
|
|
|
4859 (> (prefix-numeric-value arg) 0)
|
|
|
4860 (null efs-prompt-for-transfer-type))
|
|
|
4861 ;; turn prompting on
|
|
|
4862 (prog1
|
|
|
4863 (setq efs-prompt-for-transfer-type t)
|
|
|
4864 (message "Prompting for FTP transfer TYPE is on."))
|
|
|
4865 (prog1
|
|
|
4866 (setq efs-prompt-for-transfer-type nil)
|
|
|
4867 (message "Prompting for FTP transfer TYPE is off."))))
|
|
|
4868
|
|
|
4869 (defun efs-read-xfer-type (path)
|
|
|
4870 ;; Prompt for the transfer type to use for PATH
|
|
|
4871 (let ((type
|
|
|
4872 (completing-read
|
|
|
4873 (format "FTP transfer TYPE for %s: " (efs-relativize-filename path))
|
|
|
4874 '(("binary") ("image") ("ascii") ("ebcdic") ("tenex"))
|
|
|
4875 nil t)))
|
|
|
4876 (if (string-equal type "binary")
|
|
|
4877 'image
|
|
|
4878 (intern type))))
|
|
|
4879
|
|
|
4880 (defun efs-xfer-type (f-host-type f-path t-host-type t-path
|
|
|
4881 &optional via-local)
|
|
|
4882 ;; Returns the transfer type for transferring a file.
|
|
|
4883 ;; F-HOST-TYPE = the host type of the machine on which the file is from.
|
|
|
4884 ;; F-PATH = path, in full efs-syntax, of the original file
|
|
|
4885 ;; T-HOST-TYPE = host-type of the machine to which the file is being
|
|
|
4886 ;; transferred.
|
|
|
4887 ;; VIA-LOCAL = non-nil of the file is being moved through the local, or
|
|
|
4888 ;; a gateway machine.
|
|
|
4889 ;; Set F-PATH or T-PATH to nil, to indicate that the file is being
|
|
|
4890 ;; transferred from/to a temporary file, whose name has no significance.
|
|
|
4891 (let (temp)
|
|
|
4892 (and f-path
|
|
|
4893 (setq temp (intern-soft f-path efs-tmp-name-obarray))
|
|
|
4894 (memq temp efs-tmp-name-files)
|
|
|
4895 (setq f-path nil))
|
|
|
4896 (and t-path
|
|
|
4897 (setq temp (intern-soft t-path efs-tmp-name-obarray))
|
|
|
4898 (memq temp efs-tmp-name-files)
|
|
|
4899 (setq t-path nil)))
|
|
|
4900 (if (or (null (or f-host-type t-host-type)) (null (or f-path t-path)))
|
|
|
4901 'image ; local copy?
|
|
|
4902 (if efs-prompt-for-transfer-type
|
|
|
4903 (efs-read-xfer-type (if f-path f-path t-path))
|
|
|
4904 (let ((f-fs (cdr (assq f-host-type efs-file-type-alist)))
|
|
|
4905 (t-fs (cdr (assq t-host-type efs-file-type-alist))))
|
|
|
4906 (if (and f-fs t-fs
|
|
|
4907 (if efs-treat-crlf-as-nl
|
|
|
4908 (and (eq (car f-fs) (car t-fs))
|
|
|
4909 (eq (nth 1 f-fs) (nth 1 t-fs))
|
|
|
4910 (let ((f2-fs (nth 2 f-fs))
|
|
|
4911 (t2-fs (nth 2 t-fs)))
|
|
|
4912 (or (eq f2-fs t2-fs)
|
|
|
4913 (and (memq f2-fs '(file-crlf file-nl))
|
|
|
4914 (memq t2-fs '(file-crlf file-nl))))))
|
|
|
4915 (equal f-fs t-fs)))
|
|
|
4916 'image
|
|
|
4917 (let ((type (cond
|
|
|
4918 ((and f-path t-path)
|
|
|
4919 (efs-rationalize-file-type
|
|
|
4920 (efs-file-type t-host-type t-path)
|
|
|
4921 (efs-file-type f-host-type f-path)))
|
|
|
4922 (f-path
|
|
|
4923 (efs-file-type f-host-type f-path))
|
|
|
4924 (t-path
|
|
|
4925 (efs-file-type t-host-type t-path)))))
|
|
|
4926 (cond
|
|
|
4927 ((eq type '36-binary)
|
|
|
4928 'image)
|
|
|
4929 ((eq type '8-binary)
|
|
|
4930 (if (or (eq (car f-fs) '36-bit-wa)
|
|
|
4931 (eq (car t-fs) '36-bit-wa))
|
|
|
4932 'tenex
|
|
|
4933 'image))
|
|
|
4934 (t ; handles 'text
|
|
|
4935 (if (and t-fs f-fs (eq (nth 1 f-fs) 'ebcdic)
|
|
|
4936 (eq (nth 1 t-fs) 'ebcdic) (null via-local))
|
|
|
4937 'ebcdic
|
|
|
4938 'ascii)))))))))
|
|
|
4939
|
|
|
4940 (defun efs-set-xfer-type (host user type &optional clientless)
|
|
|
4941 ;; Sets the xfer type for HOST and USER to TYPE.
|
|
|
4942 ;; If the connection is already using the required type, does nothing.
|
|
|
4943 ;; If clientless is non-nil, we are using a quoted xfer command, and
|
|
|
4944 ;; need to check if the client has changed things.
|
|
|
4945 (save-excursion
|
|
|
4946 (let ((buff (process-buffer (efs-get-process host user))))
|
|
|
4947 (set-buffer buff)
|
|
|
4948 (or (if (and clientless efs-process-client-altered-xfer-type)
|
|
|
4949 (or (eq type efs-process-client-altered-xfer-type)
|
|
|
4950 (setq efs-process-client-altered-xfer-type nil))
|
|
|
4951 ;; We are sending a non-clientless command, so the client
|
|
|
4952 ;; gets back in synch.
|
|
|
4953 (setq efs-process-client-altered-xfer-type nil)
|
|
|
4954 (and efs-process-xfer-type
|
|
|
4955 (eq type efs-process-xfer-type)))
|
|
|
4956 (let ((otype efs-process-xfer-type))
|
|
|
4957 ;; Set this now in anticipation that the TYPE command will work,
|
|
|
4958 ;; in case other commands, such as efs-set-hash-mark-unit want to
|
|
|
4959 ;; grok this before the TYPE command completes.
|
|
|
4960 (setq efs-process-xfer-type type)
|
|
|
4961 (efs-send-cmd
|
|
|
4962 host user (list 'type type)
|
|
|
4963 nil nil
|
|
|
4964 (efs-cont (result line cont-lines) (host user type otype buff)
|
|
|
4965 (if result
|
|
|
4966 (unwind-protect
|
|
|
4967 (efs-error host user (format "TYPE %s failed: %s"
|
|
|
4968 (upcase (symbol-name type))
|
|
|
4969 line))
|
|
|
4970 (if (get-buffer buff)
|
|
|
4971 (save-excursion
|
|
|
4972 (set-buffer buff)
|
|
|
4973 (setq efs-process-xfer-type otype))))))
|
|
|
4974 0)))))) ; always send type commands NOWAIT = 0
|
|
|
4975
|
|
|
4976
|
|
|
4977 ;;;; ------------------------------------------------------------
|
|
|
4978 ;;;; Obtaining DIR listings.
|
|
|
4979 ;;;; ------------------------------------------------------------
|
|
|
4980
|
|
|
4981 (defun efs-ls-guess-switches ()
|
|
|
4982 ;; Tries to determine what would be the most useful switches
|
|
|
4983 ;; to use for a DIR listing.
|
|
|
4984 (if (and (boundp 'dired-listing-switches)
|
|
|
4985 (stringp dired-listing-switches)
|
|
|
4986 (efs-parsable-switches-p dired-listing-switches t))
|
|
|
4987 dired-listing-switches
|
|
|
4988 "-al"))
|
|
|
4989
|
|
|
4990 (efs-defun efs-ls-dumb-check nil (line host file path lsargs msg noparse
|
|
|
4991 noerror nowait cont)
|
|
|
4992 nil)
|
|
|
4993
|
|
|
4994 (efs-defun efs-ls-dumb-check unknown (line host file path lsargs
|
|
|
4995 msg noparse noerror nowait cont)
|
|
|
4996 ;; Checks to see if the host type might be dumb unix. If so, returns the
|
|
|
4997 ;; listing otherwise nil.
|
|
|
4998 (and
|
|
|
4999 lsargs
|
|
|
5000 (string-match
|
|
|
5001 ;; Some CMU servers return a 530 here. 550 is correct.
|
|
|
5002 (concat "^5[35]0 \\(The file \\)?"
|
|
|
5003 (regexp-quote (concat lsargs " " path)))
|
|
|
5004 ;; 550 is for a non-accessible file -- RFC959
|
|
|
5005 line)
|
|
|
5006 (progn
|
|
|
5007 (if (eq (efs-host-type host) 'apollo-unix)
|
|
|
5008 (efs-add-host 'dumb-apollo-unix host)
|
|
|
5009 (efs-add-host 'dumb-unix host))
|
|
|
5010 ;; try again
|
|
|
5011 (if nowait
|
|
|
5012 t ; return t if asynch
|
|
|
5013 ; This is because dumb-check can't run asynch.
|
|
|
5014 ; This means that we can't recognize dumb hosts asynch.
|
|
|
5015 ; Shouldn't be a problem.
|
|
|
5016 (efs-ls file nil
|
|
|
5017 (if (eq msg t)
|
|
|
5018 (format "Relisting %s" (efs-relativize-filename file))
|
|
|
5019 msg)
|
|
|
5020 noparse noerror nowait cont)))))
|
|
|
5021
|
|
|
5022 ;; With no-error nil, this function returns:
|
|
|
5023 ;; an error if file is not an efs-path
|
|
|
5024 ;; (This should never happen.)
|
|
|
5025 ;; an error if either the listing is unreadable or there is an ftp error.
|
|
|
5026 ;; the listing (a string), if everything works.
|
|
|
5027 ;;
|
|
|
5028 ;; With no-error t, it returns:
|
|
|
5029 ;; an error if not an efs-path
|
|
|
5030 ;; error if listing is unreable (most likely caused by a slow connection)
|
|
|
5031 ;; nil if ftp error (this is because although asking to list a nonexistent
|
|
|
5032 ;; directory on a remote unix machine usually (except
|
|
|
5033 ;; maybe for dumb hosts) returns an ls error, but no
|
|
|
5034 ;; ftp error, if the same is done on a VMS machine,
|
|
|
5035 ;; an ftp error is returned. Need to trap the error
|
|
|
5036 ;; so we can go on and try to list the parent.)
|
|
|
5037 ;; the listing, if everything works.
|
|
|
5038
|
|
|
5039 (defun efs-ls (file lsargs msg &optional noparse noerror nowait cont nlist)
|
|
|
5040 "Return the output of a `DIR' or `ls' command done over ftp.
|
|
|
5041 FILE is the full name of the remote file, LSARGS is any args to pass to the
|
|
|
5042 `ls' command. MSG is a message to be displayed while listing, if MSG is given
|
|
|
5043 as t, a suitable message will be computed. If nil, no message will be
|
|
|
5044 displayed. If NOPARSE is non-nil, then the listing will not be parsed and
|
|
|
5045 stored in internal cache. Otherwise, the listing will be parsed, if LSARGS
|
|
|
5046 allow it. If NOERROR is non-nil, then we return nil if the listing fails,
|
|
|
5047 rather than signal an error. If NOWAIT is non-nil, we do the listing
|
|
|
5048 asynchronously, returning nil. If CONT is non-nil it is called with first
|
|
|
5049 argument the listing string."
|
|
|
5050 ;; If lsargs are nil, this forces a one-time only dumb listing using dir.
|
|
|
5051 (setq file (efs-expand-file-name file))
|
|
|
5052 (let ((parsed (efs-ftp-path file)))
|
|
|
5053 (if parsed
|
|
|
5054 (let* ((host (nth 0 parsed))
|
|
|
5055 (user (nth 1 parsed))
|
|
|
5056 (path (nth 2 parsed))
|
|
|
5057 (host-type (efs-host-type host user))
|
|
|
5058 (listing-type (efs-listing-type host user))
|
|
|
5059 (parse (cond
|
|
|
5060 ((null noparse)
|
|
|
5061 (efs-parsable-switches-p lsargs t))
|
|
|
5062 ((eq noparse 'parse)
|
|
|
5063 t)
|
|
|
5064 (t nil)))
|
|
|
5065 (switches lsargs)
|
|
|
5066 cache)
|
|
|
5067
|
|
|
5068 (if (memq host-type efs-dumb-host-types)
|
|
|
5069 (setq lsargs nil))
|
|
|
5070 (if (and (null efs-ls-uncache)
|
|
|
5071 (setq cache
|
|
|
5072 (or (efs-get-from-ls-cache file switches)
|
|
|
5073 (and switches
|
|
|
5074 (efs-convert-from-ls-cache
|
|
|
5075 file switches host-type listing-type)))))
|
|
|
5076 ;; The listing is in the mail, errr... cache.
|
|
|
5077 (let (listing)
|
|
|
5078 (if (stringp cache)
|
|
|
5079 (setq listing cache)
|
|
|
5080 (setq listing (car cache))
|
|
|
5081 (if (and parse (null (nth 1 cache)))
|
|
|
5082 (save-excursion
|
|
|
5083 (set-buffer
|
|
|
5084 (let ((default-major-mode 'fundamental-mode))
|
|
|
5085 (get-buffer-create
|
|
|
5086 efs-data-buffer-name)))
|
|
|
5087 (erase-buffer)
|
|
|
5088 (insert listing)
|
|
|
5089 (goto-char (point-min))
|
|
|
5090 (efs-set-files
|
|
|
5091 file
|
|
|
5092 (efs-parse-listing listing-type
|
|
|
5093 host user path
|
|
|
5094 file lsargs))
|
|
|
5095 ;; Note that we have parsed it now.
|
|
|
5096 (setcar (cdr cache) t))))
|
|
|
5097 (if cont (efs-call-cont cont listing))
|
|
|
5098 listing)
|
|
|
5099
|
|
|
5100 (if cache
|
|
|
5101 (efs-del-from-ls-cache file nil nil))
|
|
|
5102 ;; Need to get the listing via FTP.
|
|
|
5103 (let* ((temp (efs-make-tmp-name host nil))
|
|
|
5104 (temp-file (car temp))
|
|
|
5105 listing-result)
|
|
|
5106 (efs-send-cmd
|
|
|
5107 host user
|
|
|
5108 (list (if nlist 'nlist 'dir) path (cdr temp) lsargs)
|
|
|
5109 (if (eq msg t)
|
|
|
5110 (format "Listing %s" (efs-relativize-filename file))
|
|
|
5111 msg)
|
|
|
5112 nil
|
|
|
5113 (efs-cont (result line cont-lines)
|
|
|
5114 (host-type listing-type host user temp-file path
|
|
|
5115 switches file lsargs noparse parse noerror
|
|
|
5116 msg nowait cont)
|
|
|
5117 ;; The client flipped to ascii, remember this.
|
|
|
5118 (let ((buff (get-buffer
|
|
|
5119 (efs-ftp-process-buffer host user))))
|
|
|
5120 (if buff
|
|
|
5121 (efs-save-buffer-excursion
|
|
|
5122 (set-buffer buff)
|
|
|
5123 (setq efs-process-client-altered-xfer-type
|
|
|
5124 'ascii))))
|
|
|
5125 (unwind-protect
|
|
|
5126 (if result
|
|
|
5127 (or (setq listing-result
|
|
|
5128 (efs-ls-dumb-check
|
|
|
5129 (and (or (eq host-type 'unknown)
|
|
|
5130 (eq listing-type 'unix:unknown))
|
|
|
5131 'unknown)
|
|
|
5132 line host file path lsargs msg
|
|
|
5133 noparse noerror nowait cont))
|
|
|
5134 ;; If dumb-check returns non-nil
|
|
|
5135 ;; then it would have handled any error recovery
|
|
|
5136 ;; and conts. listing-result would only be set to
|
|
|
5137 ;; t if nowait was non-nil. Therefore, the final
|
|
|
5138 ;; return for efs-ls could never be t, even if I
|
|
|
5139 ;; set listing-result to t here.
|
|
|
5140 (if noerror
|
|
|
5141 (if cont
|
|
|
5142 (efs-call-cont cont nil))
|
|
|
5143 (efs-error host user
|
|
|
5144 (concat "DIR failed: "
|
|
|
5145 line))))
|
|
|
5146
|
|
|
5147 ;; listing worked
|
|
|
5148 (if (efs-ftp-path temp-file)
|
|
|
5149 (efs-add-file-entry (efs-host-type efs-gateway-host)
|
|
|
5150 temp-file nil nil nil))
|
|
|
5151 (save-excursion
|
|
|
5152 ;; A hack to get around a jka-compr problem.
|
|
|
5153 ;; Do we still need it?
|
|
|
5154 (let ((default-major-mode 'fundamental-mode)
|
|
|
5155 efs-verbose jka-compr-enabled)
|
|
|
5156 (set-buffer (get-buffer-create
|
|
|
5157 efs-data-buffer-name))
|
|
|
5158 (erase-buffer)
|
|
|
5159 (if (or (file-readable-p temp-file)
|
|
|
5160 (sleep-for efs-retry-time)
|
|
|
5161 (file-readable-p temp-file))
|
|
|
5162 (insert-file-contents temp-file)
|
|
|
5163 (efs-error host user
|
|
|
5164 (format
|
|
|
5165 "list data file %s not readable"
|
|
|
5166 temp-file))))
|
|
|
5167 (if parse
|
|
|
5168 (progn
|
|
|
5169 (efs-set-files
|
|
|
5170 file
|
|
|
5171 (efs-parse-listing listing-type host user path
|
|
|
5172 file lsargs))
|
|
|
5173 ;; Parsing may update the host type.
|
|
|
5174 (and lsargs (memq (efs-host-type host)
|
|
|
5175 efs-dumb-host-types)
|
|
|
5176 (setq lsargs nil))))
|
|
|
5177 (let ((listing (buffer-string)))
|
|
|
5178 (efs-add-to-ls-cache file lsargs listing parse)
|
|
|
5179 (if (and (null lsargs) switches)
|
|
|
5180 ;; Try to convert
|
|
|
5181 (let ((conv (efs-get-ls-converter switches)))
|
|
|
5182 (and conv
|
|
|
5183 (setq conv (assoc
|
|
|
5184 (char-to-string 0)
|
|
|
5185 conv))
|
|
|
5186 (funcall (cdr conv) listing-type nil)
|
|
|
5187 (setq listing (buffer-string)))))
|
|
|
5188 (or nowait (setq listing-result listing))
|
|
|
5189 ;; Call the ls cont, with first arg the
|
|
|
5190 ;; listing string.
|
|
|
5191 (if cont
|
|
|
5192 (efs-call-cont cont listing)))))
|
|
|
5193 (efs-del-tmp-name temp-file)))
|
|
|
5194 nowait)
|
|
|
5195 (and (null nowait) listing-result))))
|
|
|
5196 (error "Attempt to get a remote listing for the local file %s" file))))
|
|
|
5197
|
|
|
5198
|
|
|
5199 ;;;; ===============================================================
|
|
|
5200 ;;;; >7
|
|
|
5201 ;;;; Parsing and storing remote file system data.
|
|
|
5202 ;;;; ===============================================================
|
|
|
5203
|
|
|
5204 ;;; The directory listing parsers do some host type guessing.
|
|
|
5205 ;;; Most of the host type guessing is done when the PWD output
|
|
|
5206 ;;; is parsed. A bit is done when the error codes for DIR are
|
|
|
5207 ;;; analyzed.
|
|
|
5208
|
|
|
5209 ;;;; -----------------------------------------------------------
|
|
|
5210 ;;;; Caching directory listings.
|
|
|
5211 ;;;; -----------------------------------------------------------
|
|
|
5212
|
|
|
5213 ;;; Aside from storing files data in a hashtable, a limited number
|
|
|
5214 ;;; of listings are stored in complete form in `efs-ls-cache'.
|
|
|
5215
|
|
|
5216 (defun efs-del-from-ls-cache (file &optional parent-p dir-p)
|
|
|
5217 ;; Deletes from the ls cache the listing for FILE.
|
|
|
5218 ;; With optional PARENT-P, deletes any entry for the parent
|
|
|
5219 ;; directory of FILE too.
|
|
|
5220 ;; If DIR-P is non-nil, then the directory listing of FILE is to be deleted.
|
|
|
5221 (if dir-p
|
|
|
5222 (setq file (file-name-as-directory file))
|
|
|
5223 (setq file (directory-file-name file)))
|
|
|
5224 (setq file (efs-canonize-file-name file))
|
|
|
5225 (if parent-p
|
|
|
5226 (setq parent-p (file-name-directory
|
|
|
5227 (if dir-p
|
|
|
5228 (directory-file-name file)
|
|
|
5229 file))))
|
|
|
5230 (setq efs-ls-cache
|
|
|
5231 (delq nil
|
|
|
5232 (mapcar
|
|
|
5233 (if parent-p
|
|
|
5234 (function
|
|
|
5235 (lambda (x)
|
|
|
5236 (let ((f-ent (car x)))
|
|
|
5237 (and (not (string-equal file f-ent))
|
|
|
5238 (not (string-equal parent-p f-ent))
|
|
|
5239 x))))
|
|
|
5240 (function
|
|
|
5241 (lambda (x)
|
|
|
5242 (and (not (string-equal file (car x)))
|
|
|
5243 x))))
|
|
|
5244 efs-ls-cache))))
|
|
|
5245
|
|
|
5246 (defun efs-wipe-from-ls-cache (host user)
|
|
|
5247 ;; Remove from efs-ls-cache all listings for HOST and USER.
|
|
|
5248 (let ((host (downcase host))
|
|
|
5249 (case-insens (memq (efs-host-type host)
|
|
|
5250 efs-case-insensitive-host-types)))
|
|
|
5251 (if case-insens (setq user (downcase user)))
|
|
|
5252 (setq efs-ls-cache
|
|
|
5253 (delq nil
|
|
|
5254 (mapcar
|
|
|
5255 (function
|
|
|
5256 (lambda (x)
|
|
|
5257 (let ((parsed (efs-ftp-path (car x))))
|
|
|
5258 (and (not
|
|
|
5259 (and (string-equal (car parsed) host)
|
|
|
5260 (string-equal (if case-insens
|
|
|
5261 (downcase (nth 1 parsed))
|
|
|
5262 (nth 1 parsed))
|
|
|
5263 user)))
|
|
|
5264 x))))
|
|
|
5265 efs-ls-cache)))))
|
|
|
5266
|
|
|
5267 (defun efs-get-from-ls-cache (file switches)
|
|
|
5268 ;; Returns the value in `ls-cache' for FILE and SWITCHES.
|
|
|
5269 ;; Returns a list consisting of the listing string, and whether its
|
|
|
5270 ;; already been parsed. This list is eq to the nthcdr 2 of the actual
|
|
|
5271 ;; cache entry, so you can setcar it.
|
|
|
5272 ;; For dumb listings, SWITCHES will be nil.
|
|
|
5273 (let ((list efs-ls-cache)
|
|
|
5274 (switches (efs-canonize-switches switches))
|
|
|
5275 (file (efs-canonize-file-name file)))
|
|
|
5276 (catch 'done
|
|
|
5277 (while list
|
|
|
5278 (if (and (string-equal file (car (car list)))
|
|
|
5279 (string-equal switches (nth 1 (car list))))
|
|
|
5280 (throw 'done (nthcdr 2 (car list)))
|
|
|
5281 (setq list (cdr list)))))))
|
|
|
5282
|
|
|
5283 (defun efs-add-to-ls-cache (file switches listing parsed)
|
|
|
5284 ;; Only call after efs-get-from-cache returns nil, to avoid duplicate
|
|
|
5285 ;; entries. PARSED should be t, if the listing has already been parsed.
|
|
|
5286 (and (> efs-ls-cache-max 0)
|
|
|
5287 (let ((switches (efs-canonize-switches switches))
|
|
|
5288 (file (efs-canonize-file-name file)))
|
|
|
5289 (if (= efs-ls-cache-max 1)
|
|
|
5290 (setq efs-ls-cache
|
|
|
5291 (list (list file switches listing parsed)))
|
|
|
5292 (if (>= (length efs-ls-cache) efs-ls-cache-max)
|
|
|
5293 (setcdr (nthcdr (- efs-ls-cache-max 2) efs-ls-cache) nil))
|
|
|
5294 (setq efs-ls-cache (cons (list file switches listing parsed)
|
|
|
5295 efs-ls-cache))))))
|
|
|
5296
|
|
|
5297 ;;;; --------------------------------------------------------------
|
|
|
5298 ;;;; Converting listings from cache.
|
|
|
5299 ;;;; --------------------------------------------------------------
|
|
|
5300
|
|
|
5301 (defun efs-get-ls-converter (to-switches)
|
|
|
5302 ;; Returns converter alist for TO-SWITCHES
|
|
|
5303 (efs-get-hash-entry (efs-canonize-switches to-switches)
|
|
|
5304 efs-ls-converter-hashtable))
|
|
|
5305
|
|
|
5306 (defun efs-add-ls-converter (to-switches from-switches converter)
|
|
|
5307 ;; Adds an entry to `efs-ls-converter-hashtable'.
|
|
|
5308 ;; If from-switches is t, the converter converts from internal files
|
|
|
5309 ;; hashtable.
|
|
|
5310 (let* ((to-switches (efs-canonize-switches to-switches))
|
|
|
5311 (ent (efs-get-hash-entry to-switches efs-ls-converter-hashtable))
|
|
|
5312 (add (cons (or (eq from-switches t)
|
|
|
5313 (efs-canonize-switches from-switches))
|
|
|
5314 converter)))
|
|
|
5315 (if ent
|
|
|
5316 (or (member add ent)
|
|
|
5317 (nconc ent (list add)))
|
|
|
5318 (efs-put-hash-entry to-switches (list add) efs-ls-converter-hashtable))))
|
|
|
5319
|
|
|
5320 (defun efs-convert-from-ls-cache (file switches host-type listing-type)
|
|
|
5321 ;; Returns a listing by converting the switches from a cached listing.
|
|
|
5322 (let ((clist (efs-get-ls-converter switches))
|
|
|
5323 (dir-p (= ?/ (aref file (1- (length file)))))
|
|
|
5324 elt listing result regexp alist)
|
|
|
5325 (while file ; this loop will iterate at most twice.
|
|
|
5326 (setq alist clist)
|
|
|
5327 (while alist
|
|
|
5328 (setq elt (car alist))
|
|
|
5329 (if (eq (car elt) t)
|
|
|
5330 (if (and dir-p (setq result (funcall (cdr elt) host-type
|
|
|
5331 (let ((efs-ls-uncache t))
|
|
|
5332 (efs-get-files file))
|
|
|
5333 regexp)))
|
|
|
5334 (setq alist nil
|
|
|
5335 file nil)
|
|
|
5336 (setq alist (cdr alist)))
|
|
|
5337 (if (and (setq listing
|
|
|
5338 (efs-get-from-ls-cache file (car elt)))
|
|
|
5339 (save-excursion
|
|
|
5340 (set-buffer
|
|
|
5341 (let ((default-major-mode 'fundamental-mode))
|
|
|
5342 (get-buffer-create efs-data-buffer-name)))
|
|
|
5343 (erase-buffer)
|
|
|
5344 (insert (car listing))
|
|
|
5345 (and (funcall (cdr elt) listing-type regexp)
|
|
|
5346 (setq result (buffer-string)))))
|
|
|
5347 (setq alist nil
|
|
|
5348 file nil)
|
|
|
5349 (setq alist (cdr alist)))))
|
|
|
5350 ;; Look for wildcards.
|
|
|
5351 (if (and file (null dir-p) (null regexp))
|
|
|
5352 (setq regexp (efs-shell-regexp-to-regexp
|
|
|
5353 (file-name-nondirectory file))
|
|
|
5354 file (file-name-directory file)
|
|
|
5355 dir-p t)
|
|
|
5356 (setq file nil)))
|
|
|
5357 result))
|
|
|
5358
|
|
|
5359 ;;; Define some converters
|
|
|
5360
|
|
|
5361 (defun efs-unix-t-converter-sort-pred (elt1 elt2)
|
|
|
5362 (let* ((data1 (car elt1))
|
|
|
5363 (data2 (car elt2))
|
|
|
5364 (year1 (car data1))
|
|
|
5365 (year2 (car data2))
|
|
|
5366 (month1 (nth 1 data1))
|
|
|
5367 (month2 (nth 1 data2))
|
|
|
5368 (day1 (nth 2 data1))
|
|
|
5369 (day2 (nth 2 data2))
|
|
|
5370 (hour1 (nth 3 data1))
|
|
|
5371 (hour2 (nth 3 data2))
|
|
|
5372 (minutes1 (nth 4 data1))
|
|
|
5373 (minutes2 (nth 4 data2)))
|
|
|
5374 (if year1
|
|
|
5375 (and year2
|
|
|
5376 (or (> year1 year2)
|
|
|
5377 (and (= year1 year2)
|
|
|
5378 (or (> month1 month2)
|
|
|
5379 (and (= month1 month2)
|
|
|
5380 (> day1 day2))))))
|
|
|
5381 (if year2
|
|
|
5382 t
|
|
|
5383 (or (> month1 month2)
|
|
|
5384 (and (= month1 month2)
|
|
|
5385 (or (> day1 day2)
|
|
|
5386 (and (= day1 day2)
|
|
|
5387 (or (> hour1 hour2)
|
|
|
5388 (and (= hour1 hour2)
|
|
|
5389 (> minutes1 minutes2)))))))))))
|
|
|
5390
|
|
|
5391 (defun efs-unix-t-converter (&optional regexp reverse)
|
|
|
5392 (if regexp
|
|
|
5393 nil
|
|
|
5394 (goto-char (point-min))
|
|
|
5395 (efs-save-match-data
|
|
|
5396 (if (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
5397 (let ((current-month (cdr (assoc (substring
|
|
|
5398 (current-time-string) 4 7)
|
|
|
5399 efs-month-alist)))
|
|
|
5400 list-start start end list year month day hour minutes)
|
|
|
5401 (beginning-of-line)
|
|
|
5402 (setq list-start (point))
|
|
|
5403 (while (progn
|
|
|
5404 (setq start (point))
|
|
|
5405 (forward-line 1)
|
|
|
5406 (setq end (point))
|
|
|
5407 (goto-char start)
|
|
|
5408 (re-search-forward efs-month-and-time-regexp end t))
|
|
|
5409 ;; Need to measure wrto the current month
|
|
|
5410 ;; There is a bug here if because of time-zone shifts, the
|
|
|
5411 ;; local machine and the remote one are on different months.
|
|
|
5412 (setq month (% (+ (- 11 current-month)
|
|
|
5413 (cdr (assoc
|
|
|
5414 (buffer-substring (match-beginning 2)
|
|
|
5415 (match-end 2))
|
|
|
5416 efs-month-alist))) 12)
|
|
|
5417 day (string-to-int
|
|
|
5418 (buffer-substring (match-beginning 3) (match-end 3)))
|
|
|
5419 year (buffer-substring (match-beginning 4) (match-end 4)))
|
|
|
5420 (if (string-match ":" year)
|
|
|
5421 (setq hour (string-to-int (substring year 0
|
|
|
5422 (match-beginning 0)))
|
|
|
5423 minutes (string-to-int (substring year (match-end 0)))
|
|
|
5424 year nil)
|
|
|
5425 (setq hour nil
|
|
|
5426 minutes nil
|
|
|
5427 year (string-to-int year)))
|
|
|
5428 (setq list (cons
|
|
|
5429 (cons
|
|
|
5430 (list year month day hour minutes)
|
|
|
5431 (buffer-substring start end))
|
|
|
5432 list))
|
|
|
5433 (goto-char end))
|
|
|
5434 (setq list
|
|
|
5435 (mapcar 'cdr
|
|
|
5436 (sort list 'efs-unix-t-converter-sort-pred)))
|
|
|
5437 (if reverse (setq list (nreverse list)))
|
|
|
5438 (delete-region list-start (point))
|
|
|
5439 (apply 'insert list)
|
|
|
5440 t)))))
|
|
|
5441
|
|
|
5442 (efs-defun efs-t-converter nil (&optional regexp reverse)
|
|
|
5443 ;; Converts listing without the t-switch, to ones with it.
|
|
|
5444 nil) ; by default assume that we cannot work.
|
|
|
5445
|
|
|
5446 (efs-fset 'efs-t-converter 'unix 'efs-unix-t-converter)
|
|
|
5447 (efs-fset 'efs-t-converter 'sysV-unix 'efs-unix-t-converter)
|
|
|
5448 (efs-fset 'efs-t-converter 'apollo-unix 'efs-unix-t-converter)
|
|
|
5449 (efs-fset 'efs-t-converter 'bsd-unix 'efs-unix-t-converter)
|
|
|
5450 (efs-fset 'efs-t-converter 'dumb-unix 'efs-unix-t-converter)
|
|
|
5451 (efs-fset 'efs-t-converter 'dumb-apollo-unix 'efs-unix-t-converter)
|
|
|
5452 (efs-fset 'efs-t-converter 'super-dumb-unix 'efs-unix-t-converter)
|
|
|
5453
|
|
|
5454 (defun efs-rt-converter (listing-type &optional regexp)
|
|
|
5455 ;; Reverse time sorting
|
|
|
5456 (efs-t-converter listing-type regexp t))
|
|
|
5457
|
|
|
5458 (defun efs-unix-alpha-converter (&optional regexp reverse)
|
|
|
5459 (if regexp
|
|
|
5460 nil
|
|
|
5461 (goto-char (point-min))
|
|
|
5462 (efs-save-match-data
|
|
|
5463 (if (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
5464 (let (list list-start end start next)
|
|
|
5465 (beginning-of-line)
|
|
|
5466 (setq list-start (point))
|
|
|
5467 (while (progn
|
|
|
5468 (setq start (point))
|
|
|
5469 (end-of-line)
|
|
|
5470 (setq end (point)
|
|
|
5471 next (1+ end))
|
|
|
5472 (goto-char start)
|
|
|
5473 (re-search-forward efs-month-and-time-regexp end t))
|
|
|
5474 ;; Need to measure wrto the current month
|
|
|
5475 ;; There is a bug here if because of time-zone shifts, the
|
|
|
5476 ;; local machine and the remote one are on different months.
|
|
|
5477 (setq list
|
|
|
5478 (cons
|
|
|
5479 (cons (buffer-substring (point) end)
|
|
|
5480 (buffer-substring start next))
|
|
|
5481 list))
|
|
|
5482 (goto-char next))
|
|
|
5483 (delete-region list-start (point))
|
|
|
5484 (apply 'insert
|
|
|
5485 (mapcar 'cdr
|
|
|
5486 (sort list (if reverse
|
|
|
5487 (function
|
|
|
5488 (lambda (x y)
|
|
|
5489 (string< (car y) (car x))))
|
|
|
5490 (function
|
|
|
5491 (lambda (x y)
|
|
|
5492 (string< (car x) (car y))))))))
|
|
|
5493 t)))))
|
|
|
5494
|
|
|
5495 (efs-defun efs-alpha-converter nil (&optional regexp reverse)
|
|
|
5496 ;; Converts listing to lexigraphical order.
|
|
|
5497 nil) ; by default assume that we cannot work.
|
|
|
5498
|
|
|
5499 (efs-fset 'efs-alpha-converter 'unix 'efs-unix-alpha-converter)
|
|
|
5500 (efs-fset 'efs-alpha-converter 'sysV-unix 'efs-unix-alpha-converter)
|
|
|
5501 (efs-fset 'efs-alpha-converter 'apollo-unix 'efs-unix-alpha-converter)
|
|
|
5502 (efs-fset 'efs-alpha-converter 'bsd-unix 'efs-unix-alpha-converter)
|
|
|
5503 (efs-fset 'efs-alpha-converter 'dumb-unix 'efs-unix-alpha-converter)
|
|
|
5504 (efs-fset 'efs-alpha-converter 'dumb-apollo-unix 'efs-unix-alpha-converter)
|
|
|
5505 (efs-fset 'efs-alpha-converter 'super-dumb-unix 'efs-unix-alpha-converter)
|
|
|
5506
|
|
|
5507 (defun efs-ralpha-converter (listing-type &optional regexp)
|
|
|
5508 ;; Reverse alphabetic
|
|
|
5509 (efs-alpha-converter listing-type regexp t))
|
|
|
5510
|
|
|
5511 (defun efs-unix-S-converter (&optional regexp reverse)
|
|
|
5512 (if regexp
|
|
|
5513 nil
|
|
|
5514 (goto-char (point-min))
|
|
|
5515 (efs-save-match-data
|
|
|
5516 (if (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
5517 (let (list list-start start next)
|
|
|
5518 (beginning-of-line)
|
|
|
5519 (setq list-start (point))
|
|
|
5520 (while (progn
|
|
|
5521 (setq start (point))
|
|
|
5522 (forward-line 1)
|
|
|
5523 (setq next (point))
|
|
|
5524 (goto-char start)
|
|
|
5525 (re-search-forward efs-month-and-time-regexp next t))
|
|
|
5526 ;; Need to measure wrto the current month
|
|
|
5527 ;; There is a bug here if because of time-zone shifts, the
|
|
|
5528 ;; local machine and the remote one are on different months.
|
|
|
5529 (setq list
|
|
|
5530 (cons
|
|
|
5531 (cons (string-to-int
|
|
|
5532 (buffer-substring (match-beginning 1)
|
|
|
5533 (match-end 1)))
|
|
|
5534 (buffer-substring start next))
|
|
|
5535 list))
|
|
|
5536 (goto-char next))
|
|
|
5537 (delete-region list-start (point))
|
|
|
5538 (apply 'insert
|
|
|
5539 (mapcar 'cdr
|
|
|
5540 (sort list (if reverse
|
|
|
5541 (function
|
|
|
5542 (lambda (x y)
|
|
|
5543 (< (car x) (car y))))
|
|
|
5544 (function
|
|
|
5545 (lambda (x y)
|
|
|
5546 (> (car x) (car y))))))))
|
|
|
5547 t)))))
|
|
|
5548
|
|
|
5549 (efs-defun efs-S-converter nil (&optional regexp reverse)
|
|
|
5550 ;; Converts listing without the S-switch, to ones with it.
|
|
|
5551 nil) ; by default assume that we cannot work.
|
|
|
5552
|
|
|
5553 (efs-fset 'efs-S-converter 'unix 'efs-unix-S-converter)
|
|
|
5554 (efs-fset 'efs-S-converter 'sysV-unix 'efs-unix-S-converter)
|
|
|
5555 (efs-fset 'efs-S-converter 'apollo-unix 'efs-unix-S-converter)
|
|
|
5556 (efs-fset 'efs-S-converter 'bsd-unix 'efs-unix-S-converter)
|
|
|
5557 (efs-fset 'efs-S-converter 'dumb-unix 'efs-unix-S-converter)
|
|
|
5558 (efs-fset 'efs-S-converter 'dumb-apollo-unix 'efs-unix-S-converter)
|
|
|
5559 (efs-fset 'efs-S-converter 'super-dumb-unix 'efs-unix-S-converter)
|
|
|
5560
|
|
|
5561 (defun efs-rS-converter (listing-type &optional regexp)
|
|
|
5562 ;; Reverse S switch.
|
|
|
5563 (efs-S-converter listing-type regexp t))
|
|
|
5564
|
|
|
5565 (defun efs-unix-X-converter (&optional regexp reverse)
|
|
|
5566 (if regexp
|
|
|
5567 nil
|
|
|
5568 (goto-char (point-min))
|
|
|
5569 (efs-save-match-data
|
|
|
5570 (if (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
5571 (let (next list list-start fnstart eol start end link-p)
|
|
|
5572 (beginning-of-line)
|
|
|
5573 (setq list-start (point))
|
|
|
5574 (while (progn
|
|
|
5575 (setq start (point))
|
|
|
5576 (skip-chars-forward "0-9 ")
|
|
|
5577 (setq link-p (= (following-char) ?l))
|
|
|
5578 (end-of-line)
|
|
|
5579 (setq eol (point)
|
|
|
5580 next (1+ eol))
|
|
|
5581 (goto-char start)
|
|
|
5582 (re-search-forward efs-month-and-time-regexp eol t))
|
|
|
5583 ;; Need to measure wrto the current month
|
|
|
5584 ;; There is a bug here if because of time-zone shifts, the
|
|
|
5585 ;; local machine and the remote one are on different months.
|
|
|
5586 (setq fnstart (point))
|
|
|
5587 (or (and link-p (search-forward " -> " eol t)
|
|
|
5588 (goto-char (match-beginning 0)))
|
|
|
5589 (goto-char eol))
|
|
|
5590 (setq end (point))
|
|
|
5591 (skip-chars-backward "^." fnstart)
|
|
|
5592 (setq list
|
|
|
5593 (cons
|
|
|
5594 (cons
|
|
|
5595 (if (= (point) fnstart)
|
|
|
5596 ""
|
|
|
5597 (buffer-substring (point) end))
|
|
|
5598 (buffer-substring start next))
|
|
|
5599 list))
|
|
|
5600 (goto-char next))
|
|
|
5601 (delete-region list-start (point))
|
|
|
5602 (apply 'insert
|
|
|
5603 (mapcar 'cdr
|
|
|
5604 (sort list (if reverse
|
|
|
5605 (function
|
|
|
5606 (lambda (x y)
|
|
|
5607 (string< (car y) (car x))))
|
|
|
5608 (function
|
|
|
5609 (lambda (x y)
|
|
|
5610 (string< (car x) (car y))))))))
|
|
|
5611 t)))))
|
|
|
5612
|
|
|
5613 (efs-defun efs-X-converter nil (&optional regexp reverse)
|
|
|
5614 ;; Sort on file name extension. By default do nothing
|
|
|
5615 nil)
|
|
|
5616
|
|
|
5617 (defun efs-rX-converter (listing-type &optional regexp)
|
|
|
5618 (efs-X-converter listing-type regexp t))
|
|
|
5619
|
|
|
5620 (efs-fset 'efs-X-converter 'unix 'efs-unix-X-converter)
|
|
|
5621 (efs-fset 'efs-X-converter 'sysV-unix 'efs-unix-X-converter)
|
|
|
5622 (efs-fset 'efs-X-converter 'apollo-unix 'efs-unix-X-converter)
|
|
|
5623 (efs-fset 'efs-X-converter 'bsd-unix 'efs-unix-X-converter)
|
|
|
5624 (efs-fset 'efs-X-converter 'dumb-unix 'efs-unix-X-converter)
|
|
|
5625 (efs-fset 'efs-X-converter 'dumb-apollo-unix 'efs-unix-X-converter)
|
|
|
5626 (efs-fset 'efs-X-converter 'super-dumb-unix 'efs-unix-X-converter)
|
|
|
5627
|
|
|
5628 ;;; Brief listings
|
|
|
5629
|
|
|
5630 ;;; The following functions do a heap better at packing than
|
|
|
5631 ;;; the usual ls listing. A variable column width is used.
|
|
|
5632 (defun efs-column-widths (columns list &optional across)
|
|
|
5633 ;; Returns the column widths for breaking LIST into
|
|
|
5634 ;; COLUMNS number of columns.
|
|
|
5635 (cond
|
|
|
5636 ((null list)
|
|
|
5637 nil)
|
|
|
5638 ((= columns 1)
|
|
|
5639 (list (apply 'max (mapcar 'length list))))
|
|
|
5640 ((let* ((len (length list))
|
|
|
5641 (col-length (/ len columns))
|
|
|
5642 (remainder (% len columns))
|
|
|
5643 (i 0)
|
|
|
5644 (j 0)
|
|
|
5645 (max-width 0)
|
|
|
5646 widths padding)
|
|
|
5647 (if (zerop remainder)
|
|
|
5648 (setq padding 0)
|
|
|
5649 (setq col-length (1+ col-length)
|
|
|
5650 padding (- columns remainder)))
|
|
|
5651 (setq list (nconc (copy-sequence list) (make-list padding nil)))
|
|
|
5652 (setcdr (nthcdr (1- (+ len padding)) list) list)
|
|
|
5653 (while (< i columns)
|
|
|
5654 (while (< j col-length)
|
|
|
5655 (setq max-width (max max-width (length (car list)))
|
|
|
5656 list (if across (nthcdr columns list) (cdr list))
|
|
|
5657 j (1+ j)))
|
|
|
5658 (setq widths (cons (+ max-width 2) widths)
|
|
|
5659 max-width 0
|
|
|
5660 j 0
|
|
|
5661 i (1+ i))
|
|
|
5662 (if across (setq list (cdr list))))
|
|
|
5663 (setcar widths (- (car widths) 2))
|
|
|
5664 (nreverse widths)))))
|
|
|
5665
|
|
|
5666 (defun efs-calculate-columns (list &optional across)
|
|
|
5667 ;; Returns a list of integers which are the column widths that best pack
|
|
|
5668 ;; LIST, a list of strings, onto the screen.
|
|
|
5669 (and list
|
|
|
5670 (let* ((width (1- (window-width)))
|
|
|
5671 (columns (max 1 (/ width
|
|
|
5672 (+ 2 (apply 'max (mapcar 'length list))))))
|
|
|
5673 col-list last-col-list)
|
|
|
5674 (while (<= (apply '+ (setq col-list
|
|
|
5675 (efs-column-widths columns list across)))
|
|
|
5676 width)
|
|
|
5677 (setq columns (1+ columns)
|
|
|
5678 last-col-list col-list))
|
|
|
5679 (or last-col-list col-list))))
|
|
|
5680
|
|
|
5681 (defun efs-format-columns-of-files (files &optional across)
|
|
|
5682 ;; Returns the number of lines used.
|
|
|
5683 ;; If ACROSS is non-nil, sorts across rather than down the buffer, like
|
|
|
5684 ;; ls -x
|
|
|
5685 ;; A beefed up version of the function in dired. Thanks Sebastian.
|
|
|
5686 (and files
|
|
|
5687 (let* ((columns (efs-calculate-columns files across))
|
|
|
5688 (ncols (length columns))
|
|
|
5689 (ncols1 (1- ncols))
|
|
|
5690 (nfiles (length files))
|
|
|
5691 (nrows (+ (/ nfiles ncols)
|
|
|
5692 (if (zerop (% nfiles ncols)) 0 1)))
|
|
|
5693 (space-left (- (window-width) (apply '+ columns) 1))
|
|
|
5694 (stretch (/ space-left ncols1))
|
|
|
5695 (float-stretch (if (zerop ncols1) 0 (% space-left ncols1)))
|
|
|
5696 (i 0)
|
|
|
5697 (j 0)
|
|
|
5698 (result "")
|
|
|
5699 file padding)
|
|
|
5700 (setq files (nconc (copy-sequence files) ; fill up with empty fns
|
|
|
5701 (make-list (- (* ncols nrows) nfiles) "")))
|
|
|
5702 (setcdr (nthcdr (1- (length files)) files) files) ; make circular
|
|
|
5703 (while (< j nrows)
|
|
|
5704 (while (< i ncols)
|
|
|
5705 (setq result (concat result (setq file (car files))))
|
|
|
5706 (setq padding (- (nth i columns) (length file)))
|
|
|
5707 (or (= i ncols1)
|
|
|
5708 (progn
|
|
|
5709 (setq padding (+ padding stretch))
|
|
|
5710 (if (< i float-stretch) (setq padding (1+ padding)))))
|
|
|
5711 (setq result (concat result (make-string padding ?\ )))
|
|
|
5712 (setq files (if across (cdr files) (nthcdr nrows files))
|
|
|
5713 i (1+ i)))
|
|
|
5714 (setq result (concat result "\n"))
|
|
|
5715 (setq i 0
|
|
|
5716 j (1+ j))
|
|
|
5717 (or across (setq files (cdr files))))
|
|
|
5718 result)))
|
|
|
5719
|
|
|
5720 (defun efs-brief-converter (host-type file-table F a A p x C &optional regexp)
|
|
|
5721 ;; Builds a brief directory listing for file cache, with
|
|
|
5722 ;; possible switches F, a, A, p, x.
|
|
|
5723 (efs-save-match-data
|
|
|
5724 (let (list ent modes)
|
|
|
5725 (efs-map-hashtable
|
|
|
5726 (function
|
|
|
5727 (lambda (key val)
|
|
|
5728 (if (and
|
|
|
5729 (efs-really-file-p host-type key val)
|
|
|
5730 (or a
|
|
|
5731 (and A (not (or (string-equal "." key)
|
|
|
5732 (string-equal ".." key))))
|
|
|
5733 (/= (string-to-char key) ?.))
|
|
|
5734 (or (null regexp)
|
|
|
5735 (string-match regexp key)))
|
|
|
5736 (setq ent (car val)
|
|
|
5737 modes (nth 3 val)
|
|
|
5738 list (cons
|
|
|
5739 (cond ((null (or F p))
|
|
|
5740 key)
|
|
|
5741 ((eq t ent)
|
|
|
5742 (concat key "/"))
|
|
|
5743 ((cond
|
|
|
5744 ((null F)
|
|
|
5745 key)
|
|
|
5746 ((stringp ent)
|
|
|
5747 (concat key "@"))
|
|
|
5748 ((null modes)
|
|
|
5749 key)
|
|
|
5750 ((eq (string-to-char modes) ?s)
|
|
|
5751 ;; a socket
|
|
|
5752 (concat key "="))
|
|
|
5753 ((or
|
|
|
5754 (memq (elt modes 3) '(?x ?s ?t))
|
|
|
5755 (memq (elt modes 6) '(?x ?s ?t))
|
|
|
5756 (memq (elt modes 9) '(?x ?s ?t)))
|
|
|
5757 (concat key "*"))
|
|
|
5758 (t
|
|
|
5759 key))))
|
|
|
5760 list)))))
|
|
|
5761 file-table)
|
|
|
5762 (setq list (sort list 'string<))
|
|
|
5763 (if (or C x)
|
|
|
5764 (efs-format-columns-of-files list x)
|
|
|
5765 (concat (mapconcat 'identity list "\n") "\n")))))
|
|
|
5766
|
|
|
5767 ;;; Store converters.
|
|
|
5768
|
|
|
5769 ;; The cheaters.
|
|
|
5770 (efs-add-ls-converter "-al" nil (function
|
|
|
5771 (lambda (listing-type &optional regexp)
|
|
|
5772 (null regexp))))
|
|
|
5773 (efs-add-ls-converter "-Al" nil (function
|
|
|
5774 (lambda (listing-type &optional regexp)
|
|
|
5775 (null regexp))))
|
|
|
5776 (efs-add-ls-converter "-alF" nil (function
|
|
|
5777 (lambda (listing-type &optional regexp)
|
|
|
5778 (null regexp))))
|
|
|
5779 (efs-add-ls-converter "-AlF" nil (function
|
|
|
5780 (lambda (listing-type &optional regexp)
|
|
|
5781 (null regexp))))
|
|
|
5782
|
|
|
5783 (efs-add-ls-converter "-alt" "-al" 'efs-t-converter)
|
|
|
5784 (efs-add-ls-converter "-Alt" "-Al" 'efs-t-converter)
|
|
|
5785 (efs-add-ls-converter "-lt" "-l" 'efs-t-converter)
|
|
|
5786 (efs-add-ls-converter "-altF" "-alF" 'efs-t-converter)
|
|
|
5787 (efs-add-ls-converter "-AltF" "-AlF" 'efs-t-converter)
|
|
|
5788 (efs-add-ls-converter "-ltF" "-lF" 'efs-t-converter)
|
|
|
5789 (efs-add-ls-converter "-alt" nil 'efs-t-converter)
|
|
|
5790 (efs-add-ls-converter "-altF" nil 'efs-t-converter)
|
|
|
5791 (efs-add-ls-converter "-Alt" nil 'efs-t-converter) ; cheating a bit
|
|
|
5792 (efs-add-ls-converter "-AltF" nil 'efs-t-converter) ; cheating a bit
|
|
|
5793
|
|
|
5794 (efs-add-ls-converter "-altr" "-al" 'efs-rt-converter)
|
|
|
5795 (efs-add-ls-converter "-Altr" "-Al" 'efs-rt-converter)
|
|
|
5796 (efs-add-ls-converter "-ltr" "-l" 'efs-rt-converter)
|
|
|
5797 (efs-add-ls-converter "-altFr" "-alF" 'efs-rt-converter)
|
|
|
5798 (efs-add-ls-converter "-AltFr" "-AlF" 'efs-rt-converter)
|
|
|
5799 (efs-add-ls-converter "-ltFr" "-lF" 'efs-rt-converter)
|
|
|
5800 (efs-add-ls-converter "-altr" nil 'efs-rt-converter)
|
|
|
5801 (efs-add-ls-converter "-Altr" nil 'efs-rt-converter)
|
|
|
5802
|
|
|
5803 (efs-add-ls-converter "-alr" "-alt" 'efs-alpha-converter)
|
|
|
5804 (efs-add-ls-converter "-Alr" "-Alt" 'efs-alpha-converter)
|
|
|
5805 (efs-add-ls-converter "-lr" "-lt" 'efs-alpha-converter)
|
|
|
5806 (efs-add-ls-converter "-alFr" "-alFt" 'efs-alpha-converter)
|
|
|
5807 (efs-add-ls-converter "-AlFr" "-AlFt" 'efs-alpha-converter)
|
|
|
5808 (efs-add-ls-converter "-lFr" "-lFt" 'efs-alpha-converter)
|
|
|
5809
|
|
|
5810 (efs-add-ls-converter "-al" "-alt" 'efs-alpha-converter)
|
|
|
5811 (efs-add-ls-converter "-Al" "-Alt" 'efs-alpha-converter)
|
|
|
5812 (efs-add-ls-converter "-l" "-lt" 'efs-alpha-converter)
|
|
|
5813 (efs-add-ls-converter "-alF" "-alFt" 'efs-alpha-converter)
|
|
|
5814 (efs-add-ls-converter "-AlF" "-AlFt" 'efs-alpha-converter)
|
|
|
5815 (efs-add-ls-converter "-lF" "-lFt" 'efs-alpha-converter)
|
|
|
5816 (efs-add-ls-converter nil "-alt" 'efs-alpha-converter)
|
|
|
5817
|
|
|
5818 (efs-add-ls-converter "-alr" "-al" 'efs-ralpha-converter)
|
|
|
5819 (efs-add-ls-converter "-Alr" "-Al" 'efs-ralpha-converter)
|
|
|
5820 (efs-add-ls-converter "-lr" "-l" 'efs-ralpha-converter)
|
|
|
5821 (efs-add-ls-converter "-alFr" "-alF" 'efs-ralpha-converter)
|
|
|
5822 (efs-add-ls-converter "-lAFr" "-lAF" 'efs-ralpha-converter)
|
|
|
5823 (efs-add-ls-converter "-lFr" "-lF" 'efs-ralpha-converter)
|
|
|
5824 (efs-add-ls-converter "-alr" nil 'efs-ralpha-converter)
|
|
|
5825
|
|
|
5826 (efs-add-ls-converter "-alr" "-alt" 'efs-ralpha-converter)
|
|
|
5827 (efs-add-ls-converter "-Alr" "-Alt" 'efs-ralpha-converter)
|
|
|
5828 (efs-add-ls-converter "-lr" "-lt" 'efs-ralpha-converter)
|
|
|
5829 (efs-add-ls-converter "-alFr" "-alFt" 'efs-ralpha-converter)
|
|
|
5830 (efs-add-ls-converter "-lAFr" "-lAFt" 'efs-ralpha-converter)
|
|
|
5831 (efs-add-ls-converter "-lFr" "-lFt" 'efs-ralpha-converter)
|
|
|
5832
|
|
|
5833 (efs-add-ls-converter "-alS" "-al" 'efs-S-converter)
|
|
|
5834 (efs-add-ls-converter "-AlS" "-Al" 'efs-S-converter)
|
|
|
5835 (efs-add-ls-converter "-lS" "-l" 'efs-S-converter)
|
|
|
5836 (efs-add-ls-converter "-alSF" "-alF" 'efs-S-converter)
|
|
|
5837 (efs-add-ls-converter "-AlSF" "-AlF" 'efs-S-converter)
|
|
|
5838 (efs-add-ls-converter "-lSF" "-lF" 'efs-S-converter)
|
|
|
5839 (efs-add-ls-converter "-alS" nil 'efs-S-converter)
|
|
|
5840
|
|
|
5841 (efs-add-ls-converter "-alSr" "-al" 'efs-rS-converter)
|
|
|
5842 (efs-add-ls-converter "-AlSr" "-Al" 'efs-rS-converter)
|
|
|
5843 (efs-add-ls-converter "-lSr" "-l" 'efs-rS-converter)
|
|
|
5844 (efs-add-ls-converter "-alSFr" "-alF" 'efs-rS-converter)
|
|
|
5845 (efs-add-ls-converter "-AlSFr" "-AlF" 'efs-rS-converter)
|
|
|
5846 (efs-add-ls-converter "-lSFr" "-lF" 'efs-rS-converter)
|
|
|
5847 (efs-add-ls-converter "-alSr" nil 'efs-rS-converter)
|
|
|
5848
|
|
|
5849 (efs-add-ls-converter "-alS" "-alt" 'efs-S-converter)
|
|
|
5850 (efs-add-ls-converter "-AlS" "-Alt" 'efs-S-converter)
|
|
|
5851 (efs-add-ls-converter "-lS" "-lt" 'efs-S-converter)
|
|
|
5852 (efs-add-ls-converter "-alSF" "-alFt" 'efs-S-converter)
|
|
|
5853 (efs-add-ls-converter "-AlSF" "-AlFt" 'efs-S-converter)
|
|
|
5854 (efs-add-ls-converter "-lSF" "-lFt" 'efs-S-converter)
|
|
|
5855
|
|
|
5856 (efs-add-ls-converter "-alSr" "-alt" 'efs-rS-converter)
|
|
|
5857 (efs-add-ls-converter "-AlSr" "-Alt" 'efs-rS-converter)
|
|
|
5858 (efs-add-ls-converter "-lSr" "-lt" 'efs-rS-converter)
|
|
|
5859 (efs-add-ls-converter "-alSFr" "-alFt" 'efs-rS-converter)
|
|
|
5860 (efs-add-ls-converter "-AlSFr" "-AlFt" 'efs-rS-converter)
|
|
|
5861 (efs-add-ls-converter "-lSFr" "-lFt" 'efs-rS-converter)
|
|
|
5862
|
|
|
5863 (efs-add-ls-converter "-AlX" nil 'efs-X-converter)
|
|
|
5864 (efs-add-ls-converter "-alX" nil 'efs-X-converter)
|
|
|
5865 (efs-add-ls-converter "-AlXr" nil 'efs-rX-converter)
|
|
|
5866 (efs-add-ls-converter "-alXr" nil 'efs-rX-converter)
|
|
|
5867
|
|
|
5868 (efs-add-ls-converter "-alX" "-al" 'efs-X-converter)
|
|
|
5869 (efs-add-ls-converter "-AlX" "-Al" 'efs-X-converter)
|
|
|
5870 (efs-add-ls-converter "-lX" "-l" 'efs-X-converter)
|
|
|
5871 (efs-add-ls-converter "-alXF" "-alF" 'efs-X-converter)
|
|
|
5872 (efs-add-ls-converter "-AlXF" "-AlF" 'efs-X-converter)
|
|
|
5873 (efs-add-ls-converter "-lXF" "-lF" 'efs-X-converter)
|
|
|
5874
|
|
|
5875 (efs-add-ls-converter "-alXr" "-al" 'efs-rX-converter)
|
|
|
5876 (efs-add-ls-converter "-AlXr" "-Al" 'efs-rX-converter)
|
|
|
5877 (efs-add-ls-converter "-lXr" "-l" 'efs-rX-converter)
|
|
|
5878 (efs-add-ls-converter "-alXFr" "-alF" 'efs-rX-converter)
|
|
|
5879 (efs-add-ls-converter "-AlXFr" "-AlF" 'efs-rX-converter)
|
|
|
5880 (efs-add-ls-converter "-lXFr" "-lF" 'efs-rX-converter)
|
|
|
5881
|
|
|
5882 ;;; Converters for efs-files-hashtable
|
|
|
5883
|
|
|
5884 (efs-add-ls-converter
|
|
|
5885 "" t (function
|
|
|
5886 (lambda (host-type files &optional regexp)
|
|
|
5887 (efs-brief-converter host-type files
|
|
|
5888 nil nil nil nil nil nil regexp))))
|
|
|
5889 (efs-add-ls-converter
|
|
|
5890 "-C" t (function
|
|
|
5891 (lambda (host-type files &optional regexp)
|
|
|
5892 (efs-brief-converter host-type files
|
|
|
5893 nil nil nil nil nil t regexp))))
|
|
|
5894 (efs-add-ls-converter
|
|
|
5895 "-F" t (function
|
|
|
5896 (lambda (host-type files &optional regexp)
|
|
|
5897 (efs-brief-converter host-type files
|
|
|
5898 t nil nil nil nil nil regexp))))
|
|
|
5899 (efs-add-ls-converter
|
|
|
5900 "-p" t (function
|
|
|
5901 (lambda (host-type files &optional regexp)
|
|
|
5902 (efs-brief-converter host-type files
|
|
|
5903 nil nil nil t nil nil regexp))))
|
|
|
5904 (efs-add-ls-converter
|
|
|
5905 "-CF" t (function
|
|
|
5906 (lambda (host-type files &optional regexp)
|
|
|
5907 (efs-brief-converter host-type files
|
|
|
5908 t nil nil nil nil t regexp))))
|
|
|
5909 (efs-add-ls-converter
|
|
|
5910 "-Cp" t (function
|
|
|
5911 (lambda (host-type files &optional regexp)
|
|
|
5912 (efs-brief-converter host-type files nil nil nil t nil t regexp))))
|
|
|
5913 (efs-add-ls-converter
|
|
|
5914 "-x" t (function
|
|
|
5915 (lambda (host-type files &optional regexp)
|
|
|
5916 (efs-brief-converter host-type files
|
|
|
5917 nil nil nil nil t nil regexp))))
|
|
|
5918 (efs-add-ls-converter
|
|
|
5919 "-xF" t (function
|
|
|
5920 (lambda (host-type files &optional regexp)
|
|
|
5921 (efs-brief-converter host-type files t nil nil nil t nil regexp))))
|
|
|
5922 (efs-add-ls-converter
|
|
|
5923 "-xp" t (function
|
|
|
5924 (lambda (host-type files &optional regexp)
|
|
|
5925 (efs-brief-converter host-type files nil nil nil t t nil regexp))))
|
|
|
5926 (efs-add-ls-converter
|
|
|
5927 "-Ca" t (function
|
|
|
5928 (lambda (host-type files &optional regexp)
|
|
|
5929 (efs-brief-converter host-type files nil t nil nil nil t regexp))))
|
|
|
5930 (efs-add-ls-converter
|
|
|
5931 "-CFa" t (function
|
|
|
5932 (lambda (host-type files &optional regexp)
|
|
|
5933 (efs-brief-converter host-type files t t nil nil nil t regexp))))
|
|
|
5934 (efs-add-ls-converter
|
|
|
5935 "-Cpa" t (function
|
|
|
5936 (lambda (host-type files &optional regexp)
|
|
|
5937 (efs-brief-converter host-type files nil t nil t nil t regexp))))
|
|
|
5938 (efs-add-ls-converter
|
|
|
5939 "-xa" t (function
|
|
|
5940 (lambda (host-type files &optional regexp)
|
|
|
5941 (efs-brief-converter host-type files nil t nil nil t nil regexp))))
|
|
|
5942 (efs-add-ls-converter
|
|
|
5943 "-xFa" t (function
|
|
|
5944 (lambda (host-type files &optional regexp)
|
|
|
5945 (efs-brief-converter host-type files t t nil nil t nil regexp))))
|
|
|
5946 (efs-add-ls-converter
|
|
|
5947 "-xpa" t (function
|
|
|
5948 (lambda (host-type files &optional regexp)
|
|
|
5949 (efs-brief-converter host-type files nil t nil t t nil regexp))))
|
|
|
5950 (efs-add-ls-converter
|
|
|
5951 "-CA" t (function
|
|
|
5952 (lambda (host-type files &optional regexp)
|
|
|
5953 (efs-brief-converter host-type files nil nil t nil nil t regexp))))
|
|
|
5954 (efs-add-ls-converter
|
|
|
5955 "-CFA" t (function
|
|
|
5956 (lambda (host-type files &optional regexp)
|
|
|
5957 (efs-brief-converter host-type files t nil t nil nil t regexp))))
|
|
|
5958 (efs-add-ls-converter
|
|
|
5959 "-CpA" t (function
|
|
|
5960 (lambda (host-type files &optional regexp)
|
|
|
5961 (efs-brief-converter host-type files nil nil t t nil t regexp))))
|
|
|
5962 (efs-add-ls-converter
|
|
|
5963 "-xA" t (function
|
|
|
5964 (lambda (host-type files &optional regexp)
|
|
|
5965 (efs-brief-converter host-type files nil nil t nil t nil regexp))))
|
|
|
5966 (efs-add-ls-converter
|
|
|
5967 "-xFA" t (function
|
|
|
5968 (lambda (host-type files &optional regexp)
|
|
|
5969 (efs-brief-converter host-type files t nil t nil t nil regexp))))
|
|
|
5970 (efs-add-ls-converter
|
|
|
5971 "-xpA" t (function
|
|
|
5972 (lambda (host-type files &optional regexp)
|
|
|
5973 (efs-brief-converter host-type files nil nil t t t nil regexp))))
|
|
|
5974
|
|
|
5975 ;;;; ------------------------------------------------------------
|
|
|
5976 ;;;; Directory Listing Parsers
|
|
|
5977 ;;;; ------------------------------------------------------------
|
|
|
5978
|
|
|
5979 (defconst efs-unix:dl-listing-regexp
|
|
|
5980 "^[^ \n\t]+\n? +\\([0-9]+\\|-\\|=\\) ")
|
|
|
5981
|
|
|
5982 ;; Note to progammers:
|
|
|
5983 ;; Below are a series of macros and functions used for parsing unix
|
|
|
5984 ;; file listings. They are intended only to be used together, so be careful
|
|
|
5985 ;; about using them out of context.
|
|
|
5986
|
|
|
5987 (defmacro efs-ls-parse-file-line ()
|
|
|
5988 ;; Extract the filename, size, and permission string from the current
|
|
|
5989 ;; line of a dired-like listing. Assumes that the point is at
|
|
|
5990 ;; the beginning of the line, leaves it just before the size entry.
|
|
|
5991 ;; Returns a list (name size perm-string nlinks owner).
|
|
|
5992 ;; If there is no file on the line, returns nil.
|
|
|
5993 (` (let ((eol (save-excursion (end-of-line) (point)))
|
|
|
5994 name size modes nlinks owner)
|
|
|
5995 (skip-chars-forward " 0-9" eol)
|
|
|
5996 (and
|
|
|
5997 (looking-at efs-modes-links-owner-regexp)
|
|
|
5998 (setq modes (buffer-substring (match-beginning 1)
|
|
|
5999 (match-end 1))
|
|
|
6000 nlinks (string-to-int (buffer-substring (match-beginning 2)
|
|
|
6001 (match-end 2)))
|
|
|
6002 owner (buffer-substring (match-beginning 3) (match-end 3)))
|
|
|
6003 (re-search-forward efs-month-and-time-regexp eol t)
|
|
|
6004 (setq name (buffer-substring (point) eol)
|
|
|
6005 size (string-to-int (buffer-substring (match-beginning 1)
|
|
|
6006 (match-end 1))))
|
|
|
6007 (list name size modes nlinks owner)))))
|
|
|
6008
|
|
|
6009 (defun efs-relist-symlink (host user symlink path switches)
|
|
|
6010 ;; Does a re-list of a single symlink in efs-data-buffer-name-2,
|
|
|
6011 ;; HOST = remote host
|
|
|
6012 ;; USER = remote username
|
|
|
6013 ;; SYMLINK = symbolic link name as a remote fullpath
|
|
|
6014 ;; PATH = efs full path syntax for the dir. being listed
|
|
|
6015 ;; SWITCHES = ls switches to use for the re-list
|
|
|
6016 ;; Returns (symlink-name symlink-target), as given by the listing. Returns
|
|
|
6017 ;; nil if the listing fails.
|
|
|
6018 ;; Does NOT correct for any symlink marking.
|
|
|
6019 (let* ((temp (efs-make-tmp-name host nil))
|
|
|
6020 (temp-file (car temp))
|
|
|
6021 (default-major-mode 'fundamental-mode)
|
|
|
6022 spot)
|
|
|
6023 (unwind-protect
|
|
|
6024 (and
|
|
|
6025 (prog1
|
|
|
6026 (null
|
|
|
6027 (car
|
|
|
6028 (efs-send-cmd host user
|
|
|
6029 (list 'dir symlink (cdr temp) switches)
|
|
|
6030 (format "Listing %s"
|
|
|
6031 (efs-relativize-filename
|
|
|
6032 (efs-replace-path-component
|
|
|
6033 path symlink))))))
|
|
|
6034 ;; Put the old message back.
|
|
|
6035 (if (and efs-verbose
|
|
|
6036 (not (and (boundp 'dired-in-query) dired-in-query)))
|
|
|
6037 (message "Listing %s..."
|
|
|
6038 (efs-relativize-filename path))))
|
|
|
6039 (save-excursion
|
|
|
6040 (if (efs-ftp-path temp-file)
|
|
|
6041 (efs-add-file-entry (efs-host-type efs-gateway-host)
|
|
|
6042 temp-file nil nil nil))
|
|
|
6043 (set-buffer (get-buffer-create efs-data-buffer-name-2))
|
|
|
6044 (erase-buffer)
|
|
|
6045 (if (or (file-readable-p temp-file)
|
|
|
6046 (sleep-for efs-retry-time)
|
|
|
6047 (file-readable-p temp-file))
|
|
|
6048 (let (efs-verbose)
|
|
|
6049 (insert-file-contents temp-file))
|
|
|
6050 (efs-error host user
|
|
|
6051 (format
|
|
|
6052 "list data file %s not readable" temp-file)))
|
|
|
6053 (skip-chars-forward " 0-9")
|
|
|
6054 (and
|
|
|
6055 (eq (following-char) ?l)
|
|
|
6056 (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6057 (setq spot (point))
|
|
|
6058 (re-search-forward " -> " nil t)
|
|
|
6059 (progn
|
|
|
6060 (end-of-line)
|
|
|
6061 (list
|
|
|
6062 ;; We might get the full path in the listing.
|
|
|
6063 (file-name-nondirectory
|
|
|
6064 (buffer-substring spot (match-beginning 0)))
|
|
|
6065 (buffer-substring (match-end 0) (point)))))))
|
|
|
6066 (efs-del-tmp-name temp-file))))
|
|
|
6067
|
|
|
6068 (defun efs-ls-sysV-p (host user dir linkname path)
|
|
|
6069 ;; Returns t if the symlink is listed in sysV style. i.e. The
|
|
|
6070 ;; symlink name is marked with an @.
|
|
|
6071 ;; HOST = remote host name
|
|
|
6072 ;; USER = remote user name
|
|
|
6073 ;; DIR = directory being listed as a remote full path.
|
|
|
6074 ;; LINKNAME = relative name of symbolic link as derived from an ls -..F...
|
|
|
6075 ;; this is assumed to end with an @
|
|
|
6076 ;; PATH = efs full path synatx for the directory
|
|
|
6077 (let ((link (car (efs-relist-symlink
|
|
|
6078 host user
|
|
|
6079 (concat dir (substring linkname 0 -1))
|
|
|
6080 path "-lFd" ))))
|
|
|
6081 (and link (string-equal link linkname))))
|
|
|
6082
|
|
|
6083 (defun efs-ls-next-p (host user dir linkname target path)
|
|
|
6084 ;; Returns t is the symlink is marked in the NeXT style.
|
|
|
6085 ;; i.e. The symlink destination is marked with an @.
|
|
|
6086 ;; This assumes that the host-type has already been identified
|
|
|
6087 ;; as NOT sysV-unix, and that target ends in an "@".
|
|
|
6088 ;; HOST = remote host name
|
|
|
6089 ;; USER = remote user name
|
|
|
6090 ;; DIR = remote directory being listed, as a remore full path
|
|
|
6091 ;; LINKNAME = relative name of symbolic link
|
|
|
6092 ;; Since we've eliminated sysV, it won't be marked with an @
|
|
|
6093 ;; TARGET = target of symbolic link, as derived from an ls -..F..
|
|
|
6094 ;; PATH = directory being listed in full efs path syntax.
|
|
|
6095 (let ((no-F-target (nth 1 (efs-relist-symlink
|
|
|
6096 host user
|
|
|
6097 (concat dir linkname)
|
|
|
6098 path "-ld"))))
|
|
|
6099 (and no-F-target
|
|
|
6100 (string-equal (concat no-F-target "@") target))))
|
|
|
6101
|
|
|
6102 ;; This deals with the F switch. Should also do something about
|
|
|
6103 ;; unquoting names obtained with the SysV b switch and the GNU Q
|
|
|
6104 ;; switch. See Sebastian's dired-get-filename.
|
|
|
6105
|
|
|
6106 (defun efs-ls-parser (host-type host user dir path switches)
|
|
|
6107 ;; Meant to be called by efs-parse-listing.
|
|
|
6108 ;; Assumes that point is at the beginning of the first file line.
|
|
|
6109 ;; Assumes that SWITCHES has already been bound to nil for a dumb host.
|
|
|
6110 ;; HOST-TYPE is the remote host-type
|
|
|
6111 ;; HOST is the remote host name
|
|
|
6112 ;; USER is the remote user name
|
|
|
6113 ;; DIR is the remote directory as a full path
|
|
|
6114 ;; PATH is the directory in full efs syntax, and directory syntax.
|
|
|
6115 ;; SWITCHES is the ls listing switches
|
|
|
6116 (let ((tbl (efs-make-hashtable))
|
|
|
6117 (used-F (and switches (string-match "F" switches)))
|
|
|
6118 (old-tbl (efs-get-files-hashtable-entry path))
|
|
|
6119 file-type symlink directory file size modes nlinks owner)
|
|
|
6120 (while (setq file (efs-ls-parse-file-line))
|
|
|
6121 (setq size (nth 1 file)
|
|
|
6122 modes (nth 2 file)
|
|
|
6123 nlinks (nth 3 file)
|
|
|
6124 owner (nth 4 file)
|
|
|
6125 file (car file)
|
|
|
6126 file-type (string-to-char modes)
|
|
|
6127 directory (eq file-type ?d))
|
|
|
6128 (if (eq file-type ?l)
|
|
|
6129 (if (string-match " -> " file)
|
|
|
6130 (setq symlink (substring file (match-end 0))
|
|
|
6131 file (substring file 0 (match-beginning 0)))
|
|
|
6132 ;; Shouldn't happen
|
|
|
6133 (setq symlink ""))
|
|
|
6134 (setq symlink nil))
|
|
|
6135 (if used-F
|
|
|
6136 ;; The F-switch jungle
|
|
|
6137 (let ((socket (eq file-type ?s))
|
|
|
6138 (fifo (eq file-type ?p))
|
|
|
6139 (executable
|
|
|
6140 (and (not symlink) ; x bits don't mean a thing for symlinks
|
|
|
6141 (or (memq (elt modes 3) '(?x ?s ?t))
|
|
|
6142 (memq (elt modes 6) '(?x ?s ?t))
|
|
|
6143 (memq (elt modes 9) '(?x ?s ?t))))))
|
|
|
6144 ;; Deal with marking of directories, executables, and sockets.
|
|
|
6145 (if (or (and executable (string-match "*$" file))
|
|
|
6146 (and socket (string-match "=$" file))
|
|
|
6147 (and fifo (string-match "|$" file)))
|
|
|
6148 (setq file (substring file 0 -1))
|
|
|
6149 ;; Do the symlink dance.
|
|
|
6150 (if symlink
|
|
|
6151 (let ((fat-p (string-match "@$" file))
|
|
|
6152 (sat-p (string-match "@$" symlink)))
|
|
|
6153 (cond
|
|
|
6154 ;; Those that mark the file
|
|
|
6155 ((and (memq host-type '(sysV-unix apollo-unix)) fat-p)
|
|
|
6156 (setq file (substring file 0 -1)))
|
|
|
6157 ;; Those that mark nothing
|
|
|
6158 ((memq host-type '(bsd-unix dumb-unix)))
|
|
|
6159 ;; Those that mark the target
|
|
|
6160 ((and (eq host-type 'next-unix) sat-p)
|
|
|
6161 (setq symlink (substring symlink 0 -1)))
|
|
|
6162 ;; We don't know
|
|
|
6163 ((eq host-type 'unix)
|
|
|
6164 (if fat-p
|
|
|
6165 (cond
|
|
|
6166 ((efs-ls-sysV-p host user dir
|
|
|
6167 file path)
|
|
|
6168 (setq host-type 'sysV-unix
|
|
|
6169 file (substring file 0 -1))
|
|
|
6170 (efs-add-host 'sysV-unix host)
|
|
|
6171 (efs-add-listing-type 'sysV-unix host user))
|
|
|
6172 ((and sat-p
|
|
|
6173 (efs-ls-next-p host user dir file symlink
|
|
|
6174 path))
|
|
|
6175 (setq host-type 'next-unix
|
|
|
6176 symlink (substring symlink 0 -1))
|
|
|
6177 (efs-add-host 'next-unix host)
|
|
|
6178 (efs-add-listing-type 'next-unix host user))
|
|
|
6179 (t
|
|
|
6180 (setq host-type 'bsd-unix)
|
|
|
6181 (efs-add-host 'bsd-unix host)
|
|
|
6182 (efs-add-listing-type 'bsd-unix host user)))
|
|
|
6183 (if (and sat-p
|
|
|
6184 (efs-ls-next-p host user dir file
|
|
|
6185 symlink path))
|
|
|
6186 (progn
|
|
|
6187 (setq host-type 'next-unix
|
|
|
6188 symlink (substring symlink 0 -1))
|
|
|
6189 (efs-add-host 'next-unix host)
|
|
|
6190 (efs-add-listing-type 'next-unix host user))
|
|
|
6191 (setq host-type 'bsd-unix)
|
|
|
6192 (efs-add-host 'bsd-unix host)
|
|
|
6193 (efs-add-listing-type 'bsd-unix host user)))))
|
|
|
6194 ;; Look out for marking of symlink
|
|
|
6195 ;; If we really wanted to, at this point we
|
|
|
6196 ;; could distinguish aix from hp-ux, ultrix, irix and a/ux,
|
|
|
6197 ;; allowing us to skip the re-list in the future, for the
|
|
|
6198 ;; later 4 host types. Another version...
|
|
|
6199 (if (string-match "[=|*]$" symlink)
|
|
|
6200 (let ((relist (efs-relist-symlink
|
|
|
6201 host user (concat dir file)
|
|
|
6202 path "-dl")))
|
|
|
6203 (if relist (setq symlink (nth 1 relist))))))))))
|
|
|
6204 ;; Strip / off the end unconditionally. It's not a valid file character
|
|
|
6205 ;; anyway.
|
|
|
6206 (if (string-match "/$" file) (setq file (substring file 0 -1)))
|
|
|
6207 (let ((mdtm (and old-tbl (nth 5 (efs-get-hash-entry file old-tbl)))))
|
|
|
6208 (if mdtm
|
|
|
6209 (efs-put-hash-entry file (list (or symlink directory) size owner
|
|
|
6210 modes nlinks mdtm) tbl)
|
|
|
6211 (efs-put-hash-entry file (list (or symlink directory) size owner
|
|
|
6212 modes nlinks) tbl)))
|
|
|
6213 (forward-line 1))
|
|
|
6214 (efs-put-hash-entry "." '(t) tbl)
|
|
|
6215 (efs-put-hash-entry ".." '(t) tbl)
|
|
|
6216 tbl))
|
|
|
6217
|
|
|
6218 (efs-defun efs-parse-listing nil (host user dir path &optional switches)
|
|
|
6219 ;; Parse the a listing which is assumed to be from some type of unix host.
|
|
|
6220 ;; Note that efs-key will be bound to the actual host type.
|
|
|
6221 ;; HOST = remote host name
|
|
|
6222 ;; USER = remote user name
|
|
|
6223 ;; DIR = directory as a remote full path
|
|
|
6224 ;; PATH = directory in full efs path syntax
|
|
|
6225 ;; SWITCHES = ls switches used for the listing
|
|
|
6226 (efs-save-match-data
|
|
|
6227 (cond
|
|
|
6228 ;; look for total line
|
|
|
6229 ((looking-at "^total [0-9]+$")
|
|
|
6230 (forward-line 1)
|
|
|
6231 ;; Beware of machines that put a blank line after the totals line.
|
|
|
6232 (skip-chars-forward " \t\n")
|
|
|
6233 (efs-ls-parser efs-key host user dir path switches))
|
|
|
6234 ;; look for errors
|
|
|
6235 ((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
|
|
|
6236 ;; It's an ls error message.
|
|
|
6237 nil)
|
|
|
6238 ((eobp) ; i.e. zerop buffer-size
|
|
|
6239 nil) ; assume an ls error message
|
|
|
6240 ;; look for listings without total lines
|
|
|
6241 ((re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6242 (beginning-of-line)
|
|
|
6243 (efs-ls-parser efs-key host user dir path switches))
|
|
|
6244 (t nil))))
|
|
|
6245
|
|
|
6246 (efs-defun efs-parse-listing unix:unknown
|
|
|
6247 (host user dir path &optional switches)
|
|
|
6248 ;; Parse the a listing which is assumed to be from some type of unix host,
|
|
|
6249 ;; possibly one doing a dl listing.
|
|
|
6250 ;; HOST = remote host name
|
|
|
6251 ;; USER = remote user name
|
|
|
6252 ;; DIR = directory as a remote full path
|
|
|
6253 ;; PATH = directory in full efs path syntax
|
|
|
6254 ;; SWITCHES = ls switches used for the listing
|
|
|
6255 (efs-save-match-data
|
|
|
6256 (cond
|
|
|
6257 ;; look for total line
|
|
|
6258 ((looking-at "^total [0-9]+$")
|
|
|
6259 (forward-line 1)
|
|
|
6260 ;; Beware of machines that put a blank line after the totals line.
|
|
|
6261 (skip-chars-forward " \t\n")
|
|
|
6262 ;; This will make the listing-type track the host-type.
|
|
|
6263 (efs-add-listing-type nil host user)
|
|
|
6264 (efs-ls-parser 'unix host user dir path switches))
|
|
|
6265 ;; look for errors
|
|
|
6266 ((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
|
|
|
6267 ;; It's an ls error message.
|
|
|
6268 nil)
|
|
|
6269 ((eobp) ; i.e. zerop buffer-size
|
|
|
6270 nil) ; assume an ls error message
|
|
|
6271 ;; look for listings without total lines
|
|
|
6272 ((and (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6273 (progn
|
|
|
6274 (beginning-of-line)
|
|
|
6275 (looking-at efs-modes-links-owner-regexp)))
|
|
|
6276 (efs-add-listing-type nil host user)
|
|
|
6277 (efs-ls-parser 'unix host user dir path switches))
|
|
|
6278 ;; look for dumb listings
|
|
|
6279 ((re-search-forward
|
|
|
6280 (concat (regexp-quote switches)
|
|
|
6281 " not found\\|\\(^ls: +illegal option -- \\)")
|
|
|
6282 (save-excursion (end-of-line) (point)) t)
|
|
|
6283 (if (eq (efs-host-type host) 'apollo-unix)
|
|
|
6284 (progn
|
|
|
6285 (efs-add-host 'dumb-apollo-unix host)
|
|
|
6286 (efs-add-listing-type 'dumb-apollo-unix host user))
|
|
|
6287 (efs-add-host 'dumb-unix host)
|
|
|
6288 (efs-add-listing-type 'dumb-unix host user))
|
|
|
6289 (if (match-beginning 1)
|
|
|
6290 ;; Need to try to list again.
|
|
|
6291 (let ((efs-ls-uncache t))
|
|
|
6292 (efs-ls
|
|
|
6293 path nil (format "Relisting %s" (efs-relativize-filename path)) t)
|
|
|
6294 (goto-char (point-min))
|
|
|
6295 (efs-parse-listing nil host user dir path switches))
|
|
|
6296 (if (re-search-forward "^total [0-9]+$" nil t)
|
|
|
6297 (progn
|
|
|
6298 (beginning-of-line)
|
|
|
6299 (delete-region (point-min) (point))
|
|
|
6300 (forward-line 1)
|
|
|
6301 (efs-ls-parser 'dumb-unix host user dir path switches)))))
|
|
|
6302 ;; Look for dl listings.
|
|
|
6303 ((re-search-forward efs-unix:dl-listing-regexp nil t)
|
|
|
6304 (efs-add-host 'unix host)
|
|
|
6305 (efs-add-listing-type 'unix:dl host user)
|
|
|
6306 (efs-parse-listing 'unix:dl host user dir path switches))
|
|
|
6307 ;; don't know, return nil
|
|
|
6308 (t nil))))
|
|
|
6309
|
|
|
6310 (defun efs-ls-parse-1-liner (filename buffer &optional symlink)
|
|
|
6311 ;; Parse a 1-line listing for FILENAME in BUFFER, and update
|
|
|
6312 ;; the cached info for FILENAME.
|
|
|
6313 ;; Optional SYMLINK arg gives the expected target of a symlink.
|
|
|
6314 ;; Since one-line listings are usually used to update info for
|
|
|
6315 ;; newly created files, we usually know what sort of a file to expect.
|
|
|
6316 ;; Actually trying to parse out the symlink target could be impossible
|
|
|
6317 ;; for some types of switches.
|
|
|
6318 (efs-save-buffer-excursion
|
|
|
6319 (set-buffer buffer)
|
|
|
6320 (goto-char (point-min))
|
|
|
6321 (skip-chars-forward " 0-9")
|
|
|
6322 (efs-save-match-data
|
|
|
6323 (let (modes nlinks owner size)
|
|
|
6324 (and
|
|
|
6325 (looking-at efs-modes-links-owner-regexp)
|
|
|
6326 (setq modes (buffer-substring (match-beginning 1) (match-end 1))
|
|
|
6327 nlinks (string-to-int (buffer-substring (match-beginning 2)
|
|
|
6328 (match-end 2)))
|
|
|
6329 owner (buffer-substring (match-beginning 3) (match-end 3)))
|
|
|
6330 (re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6331 (setq size (string-to-int (buffer-substring (match-beginning 1)
|
|
|
6332 (match-end 1))))
|
|
|
6333 (let* ((filename (directory-file-name filename))
|
|
|
6334 (files (efs-get-files-hashtable-entry
|
|
|
6335 (file-name-directory filename))))
|
|
|
6336 (if files
|
|
|
6337 (let* ((key (efs-get-file-part filename))
|
|
|
6338 (ignore-case (memq (efs-host-type
|
|
|
6339 (car (efs-ftp-path filename)))
|
|
|
6340 efs-case-insensitive-host-types))
|
|
|
6341 (ent (efs-get-hash-entry key files ignore-case))
|
|
|
6342 (mdtm (nth 5 ent))
|
|
|
6343 type)
|
|
|
6344 (if (= (string-to-char modes) ?l)
|
|
|
6345 (setq type
|
|
|
6346 (cond
|
|
|
6347 ((stringp symlink)
|
|
|
6348 symlink)
|
|
|
6349 ((stringp (car ent))
|
|
|
6350 (car ent))
|
|
|
6351 (t ; something weird happened.
|
|
|
6352 "")))
|
|
|
6353 (if (= (string-to-char modes) ?d)
|
|
|
6354 (setq type t)))
|
|
|
6355 (efs-put-hash-entry
|
|
|
6356 key (list type size owner modes nlinks mdtm)
|
|
|
6357 files ignore-case)))))))))
|
|
|
6358
|
|
|
6359 (efs-defun efs-update-file-info nil (file buffer &optional symlink)
|
|
|
6360 "For FILE, update cache information from a single file listing in BUFFER."
|
|
|
6361 ;; By default, this does nothing.
|
|
|
6362 nil)
|
|
|
6363
|
|
|
6364 (efs-defun efs-update-file-info unix (file buffer &optional symlink)
|
|
|
6365 (efs-ls-parse-1-liner file buffer))
|
|
|
6366 (efs-defun efs-update-file-info sysV-unix (file buffer &optional symlink)
|
|
|
6367 (efs-ls-parse-1-liner file buffer))
|
|
|
6368 (efs-defun efs-update-file-info bsd-unix (file buffer &optional symlink)
|
|
|
6369 (efs-ls-parse-1-liner file buffer))
|
|
|
6370 (efs-defun efs-update-file-info next-unix (file buffer &optional symlink)
|
|
|
6371 (efs-ls-parse-1-liner file buffer))
|
|
|
6372 (efs-defun efs-update-file-info apollo-unix (file buffer &optional symlink)
|
|
|
6373 (efs-ls-parse-1-liner file buffer))
|
|
|
6374 (efs-defun efs-update-file-info dumb-unix (file buffer &optional symlink)
|
|
|
6375 (efs-ls-parse-1-liner file buffer))
|
|
|
6376 (efs-defun efs-update-file-info dumb-apollo-unix
|
|
|
6377 (file buffer &optional symlink)
|
|
|
6378 (efs-ls-parse-1-liner file buffer))
|
|
|
6379 (efs-defun efs-update-file-info super-dumb-unix (file buffer &optional symlink)
|
|
|
6380 (efs-ls-parse-1-liner file buffer))
|
|
|
6381
|
|
|
6382 ;;;; ----------------------------------------------------------------
|
|
|
6383 ;;;; The 'unknown listing parser. This does some host-type guessing.
|
|
|
6384 ;;;; ----------------------------------------------------------------
|
|
|
6385
|
|
|
6386 ;;; Regexps for host and listing type guessing from the listing syntax.
|
|
|
6387
|
|
|
6388 (defconst efs-ka9q-listing-regexp
|
|
|
6389 (concat
|
|
|
6390 "^\\([0-9,.]+\\|No\\) files\\. [0-9,.]+ bytes free\\. "
|
|
|
6391 "Disk size [0-9,]+ bytes\\.$"))
|
|
|
6392 ;; This version of the regexp is really for hosts which allow some switches,
|
|
|
6393 ;; but not ours. Rather than determine which switches we could be using
|
|
|
6394 ;; we just assume that it's dumb.
|
|
|
6395 (defconst efs-dumb-unix-listing-regexp
|
|
|
6396 (concat
|
|
|
6397 "^[Uu]sage: +ls +-[a-zA-Z0-9]+[ \n]\\|"
|
|
|
6398 ;; Unitree server
|
|
|
6399 "^Error getting stats for \"-[a-zA-Z0-9]+\""))
|
|
|
6400
|
|
|
6401 (defconst efs-dos-distinct-date-and-time-regexp
|
|
|
6402 (concat
|
|
|
6403 " \\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct"
|
|
|
6404 "\\|Nov\\|Dec\\) [ 0-3][0-9],[12][90][0-9][0-9] "
|
|
|
6405 "[ 12][0-9]:[0-5][0-9] "))
|
|
|
6406 ;; Regexp to match the output from the hellsoft ftp server to an
|
|
|
6407 ;; ls -al. Unfortunately, this looks a lot like some unix ls error
|
|
|
6408 ;; messages.
|
|
|
6409 (defconst efs-hell-listing-regexp
|
|
|
6410 (concat
|
|
|
6411 "ls: file or directory not found\n\\'\\|"
|
|
|
6412 "[-d]\\[[-A-Z][-A-Z][-A-Z][-A-Z][-A-Z][-A-Z][-A-Z]\\]"))
|
|
|
6413
|
|
|
6414 (efs-defun efs-parse-listing unknown
|
|
|
6415 (host user dir path &optional switches)
|
|
|
6416 "Parse the current buffer which is assumed to contain a dir listing.
|
|
|
6417 Return a hashtable as the result. If the listing is not really a
|
|
|
6418 directory listing, then return nil.
|
|
|
6419
|
|
|
6420 HOST is the remote host's name.
|
|
|
6421 USER is the remote user name.
|
|
|
6422 DIR is the directory as a full remote path.
|
|
|
6423 PATH is the directory in full efs path synatx.
|
|
|
6424 SWITCHES are the switches passed to ls. If SWITCHES is nil, then a
|
|
|
6425 dumb \(with dir\) listing has been done."
|
|
|
6426 (efs-save-match-data
|
|
|
6427 (cond
|
|
|
6428
|
|
|
6429 ;; look for total line
|
|
|
6430 ((looking-at "^total [0-9]+$")
|
|
|
6431 (efs-add-host 'unix host)
|
|
|
6432 (forward-line 1)
|
|
|
6433 ;; Beware of machines that put a blank line after the totals line.
|
|
|
6434 (skip-chars-forward " \t\n")
|
|
|
6435 (efs-ls-parser 'unix host user dir path switches))
|
|
|
6436
|
|
|
6437 ;; Look for hellsoft. Need to do this before looking
|
|
|
6438 ;; for ls errors, since the hellsoft output looks a lot like an ls error.
|
|
|
6439 ((looking-at efs-hell-listing-regexp)
|
|
|
6440 (if (null (car (efs-send-cmd host user '(quote site dos))))
|
|
|
6441 (let* ((key (concat host "/" user "/~"))
|
|
|
6442 (tilde (efs-get-hash-entry
|
|
|
6443 key efs-expand-dir-hashtable)))
|
|
|
6444 (efs-add-host 'hell host)
|
|
|
6445 ;; downcase the expansion of ~
|
|
|
6446 (if (and tilde (string-match "^[^a-z]+$" tilde))
|
|
|
6447 (efs-put-hash-entry key (downcase tilde)
|
|
|
6448 efs-expand-dir-hashtable))
|
|
|
6449 ;; Downcase dir, in case its got some upper case stuff in it.
|
|
|
6450 (setq dir (downcase dir)
|
|
|
6451 path (efs-replace-path-component path dir))
|
|
|
6452 (let ((efs-ls-uncache t))
|
|
|
6453 ;; This will force the data buffer to be re-filled
|
|
|
6454 (efs-ls path nil (format "Relisting %s"
|
|
|
6455 (efs-relativize-filename path))
|
|
|
6456 t))
|
|
|
6457 (efs-parse-listing 'hell host user dir path))
|
|
|
6458 ;; Don't know, give unix a try.
|
|
|
6459 (efs-add-host 'unix host)
|
|
|
6460 nil))
|
|
|
6461
|
|
|
6462 ;; look for ls errors
|
|
|
6463 ((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
|
|
|
6464 ;; It's an ls error message.
|
|
|
6465 (efs-add-host 'unix host)
|
|
|
6466 nil)
|
|
|
6467
|
|
|
6468 ((eobp) ; i.e. (zerop (buffer-size))
|
|
|
6469 ;; This could be one of:
|
|
|
6470 ;; (1) An Ultrix ls error message
|
|
|
6471 ;; (2) A listing with the A switch of an empty directory
|
|
|
6472 ;; on a machine which doesn't give a total line.
|
|
|
6473 ;; (3) The result of an attempt at an nlist. (This would mean a
|
|
|
6474 ;; dumb host.)
|
|
|
6475 ;; (4) The twilight zone.
|
|
|
6476 (cond
|
|
|
6477 ((save-excursion
|
|
|
6478 (set-buffer (process-buffer
|
|
|
6479 (efs-get-process host user)))
|
|
|
6480 (save-excursion
|
|
|
6481 (goto-char (point-max))
|
|
|
6482 (and
|
|
|
6483 ;; The dir ftp output starts with a 200 cmd.
|
|
|
6484 (re-search-backward "^150 " nil t)
|
|
|
6485 ;; We never do an nlist (it's a short listing).
|
|
|
6486 ;; If the machine thinks that we did, it's dumb.
|
|
|
6487 (looking-at "[^\n]+ NLST "))))
|
|
|
6488 ;; It's dumb-unix or ka9q. Anything else?
|
|
|
6489 ;; This will re-fill the data buffer with a dumb listing.
|
|
|
6490 (let ((efs-ls-uncache t))
|
|
|
6491 (efs-ls path nil (format "Relisting %s"
|
|
|
6492 (efs-relativize-filename path))
|
|
|
6493 t))
|
|
|
6494 (cond
|
|
|
6495 ;; check for dumb-unix
|
|
|
6496 ((re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6497 (efs-add-host 'dumb-unix host)
|
|
|
6498 (beginning-of-line)
|
|
|
6499 (efs-parse-listing 'dumb-unix host user dir path))
|
|
|
6500 ;; check for ka9q
|
|
|
6501 ((save-excursion
|
|
|
6502 (goto-char (point-max))
|
|
|
6503 (forward-line -1)
|
|
|
6504 (looking-at efs-ka9q-listing-regexp))
|
|
|
6505 (efs-add-host 'ka9q host)
|
|
|
6506 (efs-parse-listing 'ka9q host user dir path))
|
|
|
6507 (t ; Don't know, try unix.
|
|
|
6508 (efs-add-host 'unix host)
|
|
|
6509 nil)))
|
|
|
6510 ;; check for Novell Netware
|
|
|
6511 ((null (car (efs-send-cmd host user '(quote site nfs))))
|
|
|
6512 (efs-add-host 'netware host)
|
|
|
6513 (let ((efs-ls-uncache t))
|
|
|
6514 (efs-ls path nil (format "Relisting %s"
|
|
|
6515 (efs-relativize-filename path))
|
|
|
6516 t))
|
|
|
6517 (efs-parse-listing 'netware host user dir path))
|
|
|
6518 (t
|
|
|
6519 ;; Assume (1), an Ultrix error message.
|
|
|
6520 (efs-add-host 'unix host)
|
|
|
6521 nil)))
|
|
|
6522
|
|
|
6523 ;; unix without a total line
|
|
|
6524 ((re-search-forward efs-month-and-time-regexp nil t)
|
|
|
6525 (efs-add-host 'unix host)
|
|
|
6526 (beginning-of-line)
|
|
|
6527 (efs-ls-parser 'unix host user dir path switches))
|
|
|
6528
|
|
|
6529 ;; Now we look for host-types, or listing-types which are auto-rec
|
|
|
6530 ;; by the listing parser, because it's not possible to pick them out
|
|
|
6531 ;; from a pwd.
|
|
|
6532
|
|
|
6533 ;; check for dumb-unix
|
|
|
6534 ;; (Guessing of dumb-unix hosts which return an ftp error message is
|
|
|
6535 ;; done in efs-ls.)
|
|
|
6536 ((re-search-forward efs-dumb-unix-listing-regexp nil t)
|
|
|
6537 (efs-add-host 'dumb-unix host)
|
|
|
6538 ;; This will force the data buffer to be re-filled
|
|
|
6539 (let ((efs-ls-uncache t))
|
|
|
6540 (efs-ls path nil (format "Relisting %s"
|
|
|
6541 (efs-relativize-filename path))
|
|
|
6542 t))
|
|
|
6543 (efs-parse-listing 'dumb-unix host user dir path))
|
|
|
6544
|
|
|
6545 ;; check for Distinct's DOS ftp server
|
|
|
6546 ((re-search-forward efs-dos-distinct-date-and-time-regexp nil t)
|
|
|
6547 (efs-add-host 'dos-distinct host)
|
|
|
6548 (efs-parse-listing 'dos-distinct host user dir path))
|
|
|
6549
|
|
|
6550 ;; check for KA9Q pseudo-unix (LINUX?)
|
|
|
6551 ((save-excursion
|
|
|
6552 (goto-char (point-max))
|
|
|
6553 (forward-line -1)
|
|
|
6554 (looking-at efs-ka9q-listing-regexp))
|
|
|
6555 (efs-add-host 'ka9q host)
|
|
|
6556 ;; This will re-fill the data buffer.
|
|
|
6557 ;; Need to do this because ka9q is a dumb host.
|
|
|
6558 (let ((efs-ls-uncache t))
|
|
|
6559 (efs-ls path nil (format "Relisting %s"
|
|
|
6560 (efs-relativize-filename path))
|
|
|
6561 t))
|
|
|
6562 (efs-parse-listing 'ka9q host user dir path))
|
|
|
6563
|
|
|
6564 ;; Check for a unix descriptive (dl) listing
|
|
|
6565 ;; Do this last, because it's hard to guess.
|
|
|
6566 ((re-search-forward efs-unix:dl-listing-regexp nil t)
|
|
|
6567 (efs-add-host 'unix host)
|
|
|
6568 (efs-add-listing-type 'unix:dl host user)
|
|
|
6569 (efs-parse-listing 'unix:dl host user dir path switches))
|
|
|
6570
|
|
|
6571 ;; Don't know what's going on. Return nil, and assume unix.
|
|
|
6572 (t
|
|
|
6573 (efs-add-host 'unix host)
|
|
|
6574 nil))))
|
|
|
6575
|
|
|
6576 ;;;; ------------------------------------------------------------
|
|
|
6577 ;;;; Directory information hashtable.
|
|
|
6578 ;;;; ------------------------------------------------------------
|
|
|
6579
|
|
|
6580 (efs-defun efs-really-file-p nil (file ent)
|
|
|
6581 ;; efs-files-hashtable sometimes contains fictitious entries, when
|
|
|
6582 ;; some OS's allow a file to be accessed by another name. For example,
|
|
|
6583 ;; in VMS the highest version of a file may be accessed by omitting the
|
|
|
6584 ;; the file version number. This function should return t if the
|
|
|
6585 ;; filename FILE is really a file. ENT is the hash entry of the file.
|
|
|
6586 t)
|
|
|
6587
|
|
|
6588 (efs-defun efs-add-file-entry nil (path type size owner
|
|
|
6589 &optional modes nlinks mdtm)
|
|
|
6590 ;; Add a new file entry for PATH
|
|
|
6591 ;; TYPE is nil for a plain file, t for a directory, and a string
|
|
|
6592 ;; (the target of the link) for a symlink.
|
|
|
6593 ;; SIZE is the size of the file in bytes.
|
|
|
6594 ;; OWNER is the owner of the file, as a string.
|
|
|
6595 ;; MODES is the file modes, as a string. In Unix, this will be 10 cars.
|
|
|
6596 ;; NLINKS is the number of links for the file.
|
|
|
6597 ;; MDTM is the last modtime obtained for the file. This is for
|
|
|
6598 ;; short-term cache only, as emacs often has sequences of functions
|
|
|
6599 ;; doing modtime lookup. If you really want to be sure of the modtime,
|
|
|
6600 ;; use efs-get-file-mdtm, which asks the remote server.
|
|
|
6601
|
|
|
6602 (and (eq type t)
|
|
|
6603 (setq path (directory-file-name path)))
|
|
|
6604 (let ((files (efs-get-files-hashtable-entry (file-name-directory path))))
|
|
|
6605 (if files
|
|
|
6606 (efs-put-hash-entry
|
|
|
6607 (efs-get-file-part path)
|
|
|
6608 (cond (mdtm
|
|
|
6609 (list type size owner modes nlinks
|
|
|
6610 mdtm))
|
|
|
6611 (nlinks
|
|
|
6612 (list type size owner modes nlinks))
|
|
|
6613 (modes (list type size owner modes))
|
|
|
6614 (t (list type size owner)))
|
|
|
6615 files
|
|
|
6616 (memq efs-key efs-case-insensitive-host-types)))
|
|
|
6617 (efs-del-from-ls-cache path t nil)))
|
|
|
6618
|
|
|
6619 (efs-defun efs-delete-file-entry nil (path &optional dir-p)
|
|
|
6620 "Delete the file entry for PATH, if its directory info exists."
|
|
|
6621 (if dir-p
|
|
|
6622 (progn
|
|
|
6623 (setq path (file-name-as-directory path))
|
|
|
6624 (efs-del-hash-entry (efs-canonize-file-name path)
|
|
|
6625 efs-files-hashtable)
|
|
|
6626 ;; Note that file-name-as-directory followed by
|
|
|
6627 ;; (substring path 0 -1)
|
|
|
6628 ;; serves to canonicalize directory file names to their unix form.
|
|
|
6629 ;; i.e. in VMS, FOO.DIR -> FOO/ -> FOO
|
|
|
6630 ;; PATH is supposed to be s fully expanded efs-style path.
|
|
|
6631 (setq path (substring path 0 -1))))
|
|
|
6632 (let ((files (efs-get-files-hashtable-entry (file-name-directory path))))
|
|
|
6633 (if files
|
|
|
6634 (efs-del-hash-entry
|
|
|
6635 (efs-get-file-part path)
|
|
|
6636 files
|
|
|
6637 (memq (efs-host-type (car (efs-ftp-path path)))
|
|
|
6638 efs-case-insensitive-host-types))))
|
|
|
6639 (efs-del-from-ls-cache path t nil)
|
|
|
6640 (if dir-p (efs-del-from-ls-cache path nil t)))
|
|
|
6641
|
|
|
6642 (defun efs-set-files (directory files)
|
|
|
6643 "For DIRECTORY, set or change the associated FILES hashtable."
|
|
|
6644 (if files
|
|
|
6645 (efs-put-hash-entry
|
|
|
6646 (efs-canonize-file-name (file-name-as-directory directory))
|
|
|
6647 files efs-files-hashtable)))
|
|
|
6648
|
|
|
6649 (defun efs-parsable-switches-p (switches &optional full-dir)
|
|
|
6650 ;; Returns non-nil if SWITCHES would give an ls listing suitable for parsing
|
|
|
6651 ;; If FULL-DIR is non-nil, the switches must be suitable for parsing a full
|
|
|
6652 ;; ditectory.
|
|
|
6653 (or (null switches)
|
|
|
6654 (efs-save-match-data
|
|
|
6655 (and (string-match "[aA]" switches)
|
|
|
6656 ;; g is not good enough, need l or o for owner.
|
|
|
6657 (string-match "[lo]" switches)
|
|
|
6658 ;; L shows link target, rather than link. We need both.
|
|
|
6659 (not (string-match "[RfL]" switches))
|
|
|
6660 (not (and full-dir (string-match "d" switches)))))))
|
|
|
6661
|
|
|
6662 (defun efs-get-files (directory &optional no-error)
|
|
|
6663 "For DIRECTORY, return a hashtable of file entries.
|
|
|
6664 This will give an error or return nil, depending on the value of
|
|
|
6665 NO-ERROR, if a listing for DIRECTORY cannot be obtained."
|
|
|
6666 (let ((directory (file-name-as-directory directory)))
|
|
|
6667 (or (efs-get-files-hashtable-entry directory)
|
|
|
6668 (and (efs-ls directory (efs-ls-guess-switches) t 'parse no-error)
|
|
|
6669 (efs-get-files-hashtable-entry directory)))))
|
|
|
6670
|
|
|
6671 (efs-defun efs-allow-child-lookup nil (host user dir file)
|
|
|
6672 ;; Returns non-nil if in directory DIR, FILE could possibly be a subdir
|
|
|
6673 ;; according to its file-name syntax, and therefore a child listing should
|
|
|
6674 ;; be attempted. Note that DIR is in directory syntax.
|
|
|
6675 ;; i.e. /foo/bar/, not /foo/bar.
|
|
|
6676 ;; Deal with dired. Anything else?
|
|
|
6677 (not (and (boundp 'dired-local-variables-file)
|
|
|
6678 (stringp dired-local-variables-file)
|
|
|
6679 (string-equal dired-local-variables-file file))))
|
|
|
6680
|
|
|
6681 (defmacro efs-ancestral-check (host-type path ignore-case)
|
|
|
6682 ;; Checks to see if something in a path's ancient parentage
|
|
|
6683 ;; would make it impossible for the path to exist in the directory
|
|
|
6684 ;; tree. In this case it returns nil. Otherwise returns t (there
|
|
|
6685 ;; is essentially no information returned in this case, the file
|
|
|
6686 ;; may exist or not).
|
|
|
6687 ;; This macro should make working with RCS more efficient.
|
|
|
6688 ;; It also helps with FTP servers that go into fits if we ask to
|
|
|
6689 ;; list a non-existent dir.
|
|
|
6690 ;; Yes, I know that the function mapped over the hashtable can
|
|
|
6691 ;; be written more cleanly with a concat, but this is faster.
|
|
|
6692 ;; concat's cause a lot of consing. So do regexp-quote's, but we can't
|
|
|
6693 ;; avoid it.
|
|
|
6694 ;; Probably doesn't make much sense for this to be an efs-defun, since
|
|
|
6695 ;; the host-type dependence is very mild.
|
|
|
6696 (`
|
|
|
6697 (let ((path (, path)) ; expand once
|
|
|
6698 (ignore-case (, ignore-case))
|
|
|
6699 str)
|
|
|
6700 ;; eliminate flat file systems -- should have a constant for this
|
|
|
6701 (or (memq (, host-type) '(mts cms mvs cms-knet))
|
|
|
6702 (efs-save-match-data
|
|
|
6703 (catch 'foo
|
|
|
6704 (efs-map-hashtable
|
|
|
6705 (function
|
|
|
6706 (lambda (key val)
|
|
|
6707 (and (eq (string-match (regexp-quote key) path) 0)
|
|
|
6708 (setq str (substring path (match-end 0)))
|
|
|
6709 (string-match "^[^/]+" str)
|
|
|
6710 (not (efs-hash-entry-exists-p
|
|
|
6711 (substring str 0 (match-end 0))
|
|
|
6712 val ignore-case))
|
|
|
6713 (throw 'foo nil))))
|
|
|
6714 efs-files-hashtable)
|
|
|
6715 t))))))
|
|
|
6716
|
|
|
6717 (defun efs-file-entry-p (path)
|
|
|
6718 ;; Return whether there is a file entry for PATH.
|
|
|
6719 ;; Under no circumstances does this cause FTP activity.
|
|
|
6720 (let* ((path (directory-file-name (efs-canonize-file-name path)))
|
|
|
6721 (dir (file-name-directory path))
|
|
|
6722 (file (efs-get-file-part path))
|
|
|
6723 (tbl (efs-get-files-hashtable-entry dir)))
|
|
|
6724 (and tbl (efs-hash-entry-exists-p
|
|
|
6725 file tbl
|
|
|
6726 (memq (efs-host-type (car (efs-ftp-path dir)))
|
|
|
6727 efs-case-insensitive-host-types)) t)))
|
|
|
6728
|
|
|
6729 (defun efs-get-file-entry (path)
|
|
|
6730 "Return the given file entry for PATH.
|
|
|
6731 This is a list of the form \(type size owner modes nlinks modtm\),
|
|
|
6732 where type is nil for a normal file, t for a directory, and a string for a
|
|
|
6733 symlink, size is the size of the file in bytes, if known, and modes are
|
|
|
6734 the permission modes of the file as a string. modtm is short-term the
|
|
|
6735 cache of the file modtime. It is not used by `verify-visited-file-modtime'.
|
|
|
6736 If the file isn't in the hashtable, this returns nil."
|
|
|
6737 (let* ((path (directory-file-name (efs-canonize-file-name path)))
|
|
|
6738 (dir (file-name-directory path))
|
|
|
6739 (file (efs-get-file-part path))
|
|
|
6740 (parsed (efs-ftp-path dir))
|
|
|
6741 (host (car parsed))
|
|
|
6742 (host-type (efs-host-type host))
|
|
|
6743 (ent (efs-get-files-hashtable-entry dir))
|
|
|
6744 (ignore-case (memq host-type efs-case-insensitive-host-types)))
|
|
|
6745 (if ent
|
|
|
6746 (efs-get-hash-entry file ent ignore-case)
|
|
|
6747 (let ((user (nth 1 parsed))
|
|
|
6748 (r-dir (nth 2 parsed)))
|
|
|
6749 (and (efs-ancestral-check host-type path ignore-case)
|
|
|
6750 (or (and efs-allow-child-lookup
|
|
|
6751 (efs-allow-child-lookup host-type
|
|
|
6752 host user r-dir file)
|
|
|
6753 (setq ent (efs-get-files path t))
|
|
|
6754 (efs-get-hash-entry "." ent))
|
|
|
6755 ;; i.e. it's a directory by child lookup
|
|
|
6756 (efs-get-hash-entry
|
|
|
6757 file (efs-get-files dir) ignore-case)))))))
|
|
|
6758
|
|
|
6759 (defun efs-wipe-file-entries (host user)
|
|
|
6760 "Remove cache data for all files on HOST and USER.
|
|
|
6761 This replaces the file entry information hashtable with one that
|
|
|
6762 doesn't have any entries for the given HOST, USER pair."
|
|
|
6763 (let ((new-tbl (efs-make-hashtable (length efs-files-hashtable)))
|
|
|
6764 (host (downcase host))
|
|
|
6765 (case-fold (memq (efs-host-type host)
|
|
|
6766 efs-case-insensitive-host-types)))
|
|
|
6767 (if case-fold (setq user (downcase user)))
|
|
|
6768 (efs-map-hashtable
|
|
|
6769 (function
|
|
|
6770 (lambda (key val)
|
|
|
6771 (let ((parsed (efs-ftp-path key)))
|
|
|
6772 (if parsed
|
|
|
6773 (let ((h (nth 0 parsed))
|
|
|
6774 (u (nth 1 parsed)))
|
|
|
6775 (or (and (string-equal host (downcase h))
|
|
|
6776 (string-equal user (if case-fold (downcase u) u)))
|
|
|
6777 (efs-put-hash-entry key val new-tbl)))))))
|
|
|
6778 efs-files-hashtable)
|
|
|
6779 (setq efs-files-hashtable new-tbl)))
|
|
|
6780
|
|
|
6781
|
|
|
6782 ;;;; ============================================================
|
|
|
6783 ;;;; >8
|
|
|
6784 ;;;; Redefinitions of standard GNU Emacs functions.
|
|
|
6785 ;;;; ============================================================
|
|
|
6786
|
|
|
6787 ;;;; ------------------------------------------------------------
|
|
|
6788 ;;;; expand-file-name and friends...
|
|
|
6789 ;;;; ------------------------------------------------------------
|
|
|
6790
|
|
|
6791 ;; New filename expansion code for efs.
|
|
|
6792 ;; The overall structure is based around the following internal
|
|
|
6793 ;; functions and macros. Since these are internal, they do NOT
|
|
|
6794 ;; call efs-save-match-data. This is done by their calling
|
|
|
6795 ;; function.
|
|
|
6796 ;;
|
|
|
6797 ;; efs-expand-tilde
|
|
|
6798 ;; - expands all ~ constructs, both local and remote.
|
|
|
6799 ;; efs-short-circuit-file-name
|
|
|
6800 ;; - short-circuits //'s and /~'s, for both local and remote paths.
|
|
|
6801 ;; efs-de-dot-file-name
|
|
|
6802 ;; - canonizes /../ and /./'s in both local and remote paths.
|
|
|
6803 ;;
|
|
|
6804 ;; The following two functions overload existing emacs functions.
|
|
|
6805 ;; They are the entry points to this filename expansion code, and as such
|
|
|
6806 ;; call efs-save-match-data.
|
|
|
6807 ;;
|
|
|
6808 ;; efs-expand-file-name
|
|
|
6809 ;; efs-substitute-in-file-name
|
|
|
6810
|
|
|
6811 ;;; utility macros
|
|
|
6812
|
|
|
6813 (defmacro efs-short-circuit-file-name (filename)
|
|
|
6814 ;; Short-circuits //'s and /~'s in filenames.
|
|
|
6815 ;; Returns a list consisting of the local path,
|
|
|
6816 ;; host-type, host, user. For local hosts,
|
|
|
6817 ;; host-type, host, and user are all nil.
|
|
|
6818 (`
|
|
|
6819 (let ((start 0)
|
|
|
6820 (string (, filename))
|
|
|
6821 backskip regexp lbackskip
|
|
|
6822 lregexp parsed host-type host user)
|
|
|
6823
|
|
|
6824 (if efs-local-apollo-unix
|
|
|
6825 (setq lregexp ".//+"
|
|
|
6826 lbackskip 2)
|
|
|
6827 (setq lregexp "//+"
|
|
|
6828 lbackskip 1))
|
|
|
6829
|
|
|
6830 ;; Short circuit /user@mach: roots. It is important to do this
|
|
|
6831 ;; now to avoid unnecessary ftp connections.
|
|
|
6832
|
|
|
6833 (while (string-match efs-path-root-short-circuit-regexp string start)
|
|
|
6834 (setq start (1+ (match-beginning 0))))
|
|
|
6835 (or (zerop start) (setq string (substring string start)
|
|
|
6836 start 0))
|
|
|
6837
|
|
|
6838 ;; identify remote root
|
|
|
6839
|
|
|
6840 (if (setq parsed (efs-ftp-path-macro string))
|
|
|
6841 (if (memq (setq string (nth 2 parsed)
|
|
|
6842 host-type
|
|
|
6843 (efs-host-type (setq host (car parsed))
|
|
|
6844 (setq user (nth 1 parsed))))
|
|
|
6845 '(apollo-unix dumb-apollo-unix))
|
|
|
6846 (setq regexp ".//+"
|
|
|
6847 backskip 2)
|
|
|
6848 (setq regexp "//+"
|
|
|
6849 backskip 1))
|
|
|
6850 (setq regexp lregexp
|
|
|
6851 backskip lbackskip))
|
|
|
6852
|
|
|
6853 ;; Now short-circuit in an apollo and efs sensitive way.
|
|
|
6854
|
|
|
6855 (while (cond ((string-match regexp string start)
|
|
|
6856 (setq start (- (match-end 0) backskip)))
|
|
|
6857 ((string-match "/~" string start)
|
|
|
6858 (setq start (1- (match-end 0)))))
|
|
|
6859
|
|
|
6860 (and host-type
|
|
|
6861 (null efs-short-circuit-to-remote-root)
|
|
|
6862 (setq host-type nil
|
|
|
6863 regexp lregexp
|
|
|
6864 backskip lbackskip)))
|
|
|
6865 (or (zerop start) (setq string (substring string start)))
|
|
|
6866 (list string host-type (and host-type host) (and host-type user)))))
|
|
|
6867
|
|
|
6868 (defmacro efs-expand-tilde (tilde host-type host user)
|
|
|
6869 ;; Expands a TILDE (~ or ~sandy type construction)
|
|
|
6870 ;; Takes as an arg a filename (not directory name!)
|
|
|
6871 ;; and returns a filename. HOST-TYPE is the type of remote host.
|
|
|
6872 ;; nil is the type of the local host.
|
|
|
6873 (`
|
|
|
6874 (if (, host-type) ; nil host-type is the local machine
|
|
|
6875 (let* ((host (downcase (, host)))
|
|
|
6876 (host-type (, host-type))
|
|
|
6877 (ignore-case (memq host-type
|
|
|
6878 efs-case-insensitive-host-types))
|
|
|
6879 (tilde (, tilde))
|
|
|
6880 (user (, user))
|
|
|
6881 (key (concat host "/" user "/" tilde))
|
|
|
6882 (res (efs-get-hash-entry
|
|
|
6883 key efs-expand-dir-hashtable ignore-case)))
|
|
|
6884 (or res
|
|
|
6885 ;; for real accounts on unix systems, use the get trick
|
|
|
6886 (and (not (efs-anonymous-p user))
|
|
|
6887 (memq host-type efs-unix-host-types)
|
|
|
6888 (let ((line (nth 1 (efs-send-cmd
|
|
|
6889 host user
|
|
|
6890 (list 'get tilde "/dev/null")
|
|
|
6891 (format "expanding %s" tilde)))))
|
|
|
6892 (setq res
|
|
|
6893 (and (string-match efs-expand-dir-msgs line)
|
|
|
6894 (substring line
|
|
|
6895 (match-beginning 1)
|
|
|
6896 (match-end 1))))
|
|
|
6897 (if res
|
|
|
6898 (progn
|
|
|
6899 (setq res (efs-internal-directory-file-name res))
|
|
|
6900 (efs-put-hash-entry
|
|
|
6901 key res efs-expand-dir-hashtable ignore-case)
|
|
|
6902 res))))
|
|
|
6903 (progn
|
|
|
6904 (setq res
|
|
|
6905 (if (string-equal tilde "~")
|
|
|
6906 (car (efs-send-pwd
|
|
|
6907 host-type host user))
|
|
|
6908 (let* ((home-key (concat host "/" user "/~"))
|
|
|
6909 (home (efs-get-hash-entry
|
|
|
6910 home-key efs-expand-dir-hashtable
|
|
|
6911 ignore-case))
|
|
|
6912 pwd-result)
|
|
|
6913 (if home
|
|
|
6914 (setq home
|
|
|
6915 (efs-fix-path
|
|
|
6916 host-type
|
|
|
6917 (efs-internal-file-name-as-directory
|
|
|
6918 host-type home)))
|
|
|
6919 (if (setq home
|
|
|
6920 (car
|
|
|
6921 (setq pwd-result
|
|
|
6922 (efs-send-pwd
|
|
|
6923 host-type
|
|
|
6924 host user))))
|
|
|
6925 (efs-put-hash-entry
|
|
|
6926 home-key
|
|
|
6927 (efs-internal-directory-file-name
|
|
|
6928 (efs-fix-path host-type home 'reverse))
|
|
|
6929 efs-expand-dir-hashtable ignore-case)
|
|
|
6930 (efs-error host user
|
|
|
6931 (concat "PWD failed: "
|
|
|
6932 (cdr pwd-result)))))
|
|
|
6933 (unwind-protect
|
|
|
6934 (and (efs-raw-send-cd host user
|
|
|
6935 (efs-fix-path
|
|
|
6936 host-type tilde) t)
|
|
|
6937 (car
|
|
|
6938 (efs-send-pwd
|
|
|
6939 host-type host user)))
|
|
|
6940 (efs-raw-send-cd host user home)))))
|
|
|
6941 (if res
|
|
|
6942 (progn
|
|
|
6943 (setq res (efs-internal-directory-file-name
|
|
|
6944 (efs-fix-path host-type res 'reverse)))
|
|
|
6945 (efs-put-hash-entry
|
|
|
6946 key res efs-expand-dir-hashtable ignore-case)
|
|
|
6947 res)))
|
|
|
6948 (if (string-equal tilde "~")
|
|
|
6949 (error "Cannot get home directory on %s" host)
|
|
|
6950 (error "User %s is not known on %s" (substring tilde 1) host))))
|
|
|
6951 ;; local machine
|
|
|
6952 (efs-real-expand-file-name (, tilde)))))
|
|
|
6953
|
|
|
6954 (defmacro efs-de-dot-file-name (string)
|
|
|
6955 ;; Takes a string as arguments, and removes /../'s and /./'s.
|
|
|
6956 (`
|
|
|
6957 (let ((string (, string))
|
|
|
6958 (start 0)
|
|
|
6959 new make-dir)
|
|
|
6960 ;; to make the regexp's simpler, canonicalize to directory name.
|
|
|
6961 (if (setq make-dir (string-match "/\\.\\.?$" string))
|
|
|
6962 (setq string (concat string "/")))
|
|
|
6963 (while (string-match "/\\./" string start)
|
|
|
6964 (setq new (concat new
|
|
|
6965 (substring string
|
|
|
6966 start (match-beginning 0)))
|
|
|
6967 start (1- (match-end 0))))
|
|
|
6968
|
|
|
6969 (if new (setq string (concat new (substring string start))))
|
|
|
6970
|
|
|
6971 (while (string-match "/[^/]+/\\.\\./" string)
|
|
|
6972 ;; Is there a way to avoid all this concating and copying?
|
|
|
6973 (setq string (concat (substring string 0 (1+ (match-beginning 0)))
|
|
|
6974 (substring string (match-end 0)))))
|
|
|
6975
|
|
|
6976 ;; Do /../ and //../ special cases. They should expand to
|
|
|
6977 ;; / and //, respectively.
|
|
|
6978 (if (string-match "^\\(/+\\)\\.\\./" string)
|
|
|
6979 (setq string (concat (substring string 0 (match-end 1))
|
|
|
6980 (substring string (match-end 0)))))
|
|
|
6981
|
|
|
6982 (if (and make-dir
|
|
|
6983 (not (string-match "^/+$" string)))
|
|
|
6984 (substring string 0 -1)
|
|
|
6985 string))))
|
|
|
6986
|
|
|
6987 (defun efs-substitute-in-file-name (string)
|
|
|
6988 "Documented as original."
|
|
|
6989 ;; Because of the complicated interaction between short-circuiting
|
|
|
6990 ;; and environment variable substitution, this can't call the macro
|
|
|
6991 ;; efs-short-circuit-file-name.
|
|
|
6992 (efs-save-match-data
|
|
|
6993 (let ((start 0)
|
|
|
6994 var new root backskip regexp lbackskip
|
|
|
6995 lregexp parsed fudge-host-type rstart error)
|
|
|
6996
|
|
|
6997 (if efs-local-apollo-unix
|
|
|
6998 (setq lregexp ".//+"
|
|
|
6999 lbackskip 2)
|
|
|
7000 (setq lregexp "//+"
|
|
|
7001 lbackskip 1))
|
|
|
7002
|
|
|
7003 ;; Subst. existing env variables
|
|
|
7004 (while (string-match "\\$" string start)
|
|
|
7005 (setq new (concat new (substring string start (match-beginning 0)))
|
|
|
7006 start (match-end 0))
|
|
|
7007 (cond ((eq (string-match "\\$" string start) start)
|
|
|
7008 (setq start (1+ start)
|
|
|
7009 new (concat new "$$")))
|
|
|
7010 ((eq (string-match "{" string start) start)
|
|
|
7011 (if (and (string-match "}" string start)
|
|
|
7012 (setq var (getenv
|
|
|
7013 (substring string (1+ start)
|
|
|
7014 (1- (match-end 0))))))
|
|
|
7015 (setq start (match-end 0)
|
|
|
7016 new (concat new var))
|
|
|
7017 (setq new (concat new "$"))))
|
|
|
7018 ((eq (string-match "[a-zA-Z0-9]+" string start) start)
|
|
|
7019 (if (setq var (getenv
|
|
|
7020 (substring string start (match-end 0))))
|
|
|
7021 (setq start (match-end 0)
|
|
|
7022 new (concat new var))
|
|
|
7023 (setq new (concat new "$"))))
|
|
|
7024 ((setq new (concat new "$")))))
|
|
|
7025 (if new (setq string (concat new (substring string start))
|
|
|
7026 start 0))
|
|
|
7027
|
|
|
7028 ;; Short circuit /user@mach: roots. It is important to do this
|
|
|
7029 ;; now to avoid unnecessary ftp connections.
|
|
|
7030
|
|
|
7031 (while (string-match efs-path-root-short-circuit-regexp
|
|
|
7032 string start)
|
|
|
7033 (setq start (1+ (match-beginning 0))))
|
|
|
7034 (or (zerop start) (setq string (substring string start)
|
|
|
7035 start 0))
|
|
|
7036
|
|
|
7037 ;; Look for invalid environment variables in the root. If one is found,
|
|
|
7038 ;; we set the host-type to 'unix. Since we can't login in to determine
|
|
|
7039 ;; it. There is a good chance that we will bomb later with an error,
|
|
|
7040 ;; but the day may yet be saved if the root is short-circuited off.
|
|
|
7041
|
|
|
7042 (if (string-match efs-path-root-regexp string)
|
|
|
7043 (progn
|
|
|
7044 (setq root (substring string 0 (match-end 0))
|
|
|
7045 start (match-end 0))
|
|
|
7046 (if (string-match "[^$]\\(\\$\\$\\)*\\$[^$]" root)
|
|
|
7047 (progn
|
|
|
7048 (setq rstart (1- (match-end 0))
|
|
|
7049 fudge-host-type t)
|
|
|
7050 (cond
|
|
|
7051 ((eq (elt root rstart) ?{)
|
|
|
7052 (setq
|
|
|
7053 error
|
|
|
7054 (if (string-match "}" root rstart)
|
|
|
7055 (concat
|
|
|
7056 "Subsituting non-existent environment variable "
|
|
|
7057 (substring root (1+ rstart) (match-beginning 0)))
|
|
|
7058 "Missing \"}\" in environment-variable substitution")))
|
|
|
7059 ((eq (string-match "[A-Za-z0-9]+" root rstart) rstart)
|
|
|
7060 (setq
|
|
|
7061 error
|
|
|
7062 (concat
|
|
|
7063 "Subsituting non-existent environment variable "
|
|
|
7064 (substring root rstart (match-beginning 0)))))
|
|
|
7065 (t
|
|
|
7066 (setq
|
|
|
7067 error
|
|
|
7068 "Bad format environment-variable substitution")))))
|
|
|
7069 (setq root (efs-unquote-dollars root)
|
|
|
7070 parsed (efs-ftp-path root))
|
|
|
7071
|
|
|
7072 (if (and (not fudge-host-type)
|
|
|
7073 ;; This may trigger an FTP connection
|
|
|
7074 (memq (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7075 '(apollo-unix dumb-apollo-unix)))
|
|
|
7076 (setq regexp ".//+"
|
|
|
7077 backskip 2)
|
|
|
7078 (setq regexp "//+"
|
|
|
7079 backskip 1)))
|
|
|
7080 ;; no root, we're local
|
|
|
7081 (setq regexp lregexp
|
|
|
7082 backskip lbackskip))
|
|
|
7083
|
|
|
7084 ;; Now short-circuit in an apollo and efs sensitive way.
|
|
|
7085
|
|
|
7086 (while (cond ((string-match regexp string start)
|
|
|
7087 (setq start (- (match-end 0) backskip)))
|
|
|
7088 ((string-match "/~" string start)
|
|
|
7089 (setq start (1- (match-end 0)))))
|
|
|
7090
|
|
|
7091 (and root
|
|
|
7092 (null efs-short-circuit-to-remote-root)
|
|
|
7093 (setq root nil
|
|
|
7094 regexp lregexp
|
|
|
7095 backskip lbackskip)))
|
|
|
7096
|
|
|
7097 ;; If we still have a bad root, barf.
|
|
|
7098 (if (and root error) (error error))
|
|
|
7099
|
|
|
7100 ;; look for non-existent evironment variables in the path
|
|
|
7101
|
|
|
7102 (if (string-match
|
|
|
7103 "\\([^$]\\|^\\)\\(\\$\\$\\)*\\$\\([^$]\\|$\\)" string start)
|
|
|
7104 (progn
|
|
|
7105 (setq start (match-beginning 3))
|
|
|
7106 (cond
|
|
|
7107 ((eq (length string) start)
|
|
|
7108 (error "Empty string is an invalid environment variable"))
|
|
|
7109 ((eq (elt string start) ?{)
|
|
|
7110 (if (string-match "}" string start)
|
|
|
7111 (error
|
|
|
7112 "Subsituting non-existent environment variable %s"
|
|
|
7113 (substring string (1+ start) (match-end 0)))
|
|
|
7114 (error
|
|
|
7115 "Missing \"}\" in environment-variable substitution")))
|
|
|
7116 ((eq (string-match "[A-Za-z0-9]+" string start) start)
|
|
|
7117 (error
|
|
|
7118 "Subsituting non-existent environment variable %s"
|
|
|
7119 (substring string start (match-end 0))))
|
|
|
7120 (t
|
|
|
7121 (error
|
|
|
7122 "Bad format environment-variable substitution")))))
|
|
|
7123
|
|
|
7124 (if root
|
|
|
7125 (concat root
|
|
|
7126 (efs-unquote-dollars
|
|
|
7127 (if (zerop start)
|
|
|
7128 string
|
|
|
7129 (substring string start))))
|
|
|
7130 (efs-unquote-dollars
|
|
|
7131 (if (zerop start)
|
|
|
7132 string
|
|
|
7133 (substring string start)))))))
|
|
|
7134
|
|
|
7135 (defun efs-expand-file-name (name &optional default)
|
|
|
7136 "Documented as original."
|
|
|
7137 (let (s-c-res path host user host-type)
|
|
|
7138 (efs-save-match-data
|
|
|
7139 (or (file-name-absolute-p name)
|
|
|
7140 (setq name (concat
|
|
|
7141 (file-name-as-directory
|
|
|
7142 (or default default-directory))
|
|
|
7143 name)))
|
|
|
7144 (setq s-c-res (efs-short-circuit-file-name name)
|
|
|
7145 path (car s-c-res)
|
|
|
7146 host-type (nth 1 s-c-res)
|
|
|
7147 host (nth 2 s-c-res)
|
|
|
7148 user (nth 3 s-c-res))
|
|
|
7149 (cond ((string-match "^~[^/]*" path)
|
|
|
7150 (let ((start (match-end 0)))
|
|
|
7151 (setq path (concat
|
|
|
7152 (efs-expand-tilde
|
|
|
7153 (substring path 0 start)
|
|
|
7154 host-type host user)
|
|
|
7155 (substring path start)))))
|
|
|
7156 ((and host-type (not (file-name-absolute-p path)))
|
|
|
7157 ;; We expand the empty string to a directory.
|
|
|
7158 ;; This can be more efficient for filename
|
|
|
7159 ;; completion. It's also consistent with non-unix.
|
|
|
7160 (let ((tilde (efs-expand-tilde
|
|
|
7161 "~" host-type host user)))
|
|
|
7162 (if (string-equal tilde "/")
|
|
|
7163 (setq path (concat "/" path))
|
|
|
7164 (setq path (concat tilde "/" path))))))
|
|
|
7165
|
|
|
7166 (setq path (efs-de-dot-file-name path))
|
|
|
7167 (if host-type
|
|
|
7168 (format efs-path-format-string user host path)
|
|
|
7169 path))))
|
|
|
7170
|
|
|
7171 ;;;; ------------------------------------------------------------
|
|
|
7172 ;;;; Other functions for manipulating file names.
|
|
|
7173 ;;;; ------------------------------------------------------------
|
|
|
7174
|
|
|
7175 (defun efs-internal-file-name-extension (filename)
|
|
|
7176 ;; Returns the extension for file name FN.
|
|
|
7177 (save-match-data
|
|
|
7178 (let ((file (file-name-sans-versions (file-name-nondirectory filename))))
|
|
|
7179 (if (string-match "\\.[^.]*\\'" file)
|
|
|
7180 (substring file (match-beginning 0))
|
|
|
7181 ""))))
|
|
|
7182
|
|
|
7183 (defun efs-file-name-as-directory (name)
|
|
|
7184 ;; version of file-name-as-directory for remote files.
|
|
|
7185 ;; Usually just appends a / if there isn't one already.
|
|
|
7186 ;; For some systems, it may also remove .DIR like extensions.
|
|
|
7187 (let* ((parsed (efs-ftp-path name))
|
|
|
7188 (file (nth 2 parsed)))
|
|
|
7189 (if (string-equal file "")
|
|
|
7190 name
|
|
|
7191 (efs-internal-file-name-as-directory
|
|
|
7192 (efs-host-type (car parsed) (nth 1 parsed)) name))))
|
|
|
7193
|
|
|
7194 (efs-defun efs-internal-file-name-as-directory nil (name)
|
|
|
7195 ;; By default, simply adds a trailing /, if there isn't one.
|
|
|
7196 ;; Note that for expanded filenames, it pays to call this rather
|
|
|
7197 ;; than efs-file-name-as-directory.
|
|
|
7198 (let (file-name-handler-alist)
|
|
|
7199 (file-name-as-directory name)))
|
|
|
7200
|
|
|
7201 (defun efs-file-name-directory (name)
|
|
|
7202 ;; file-name-directory for remote files. Takes care not to
|
|
|
7203 ;; turn /user@host: into /.
|
|
|
7204 (let ((path (nth 2 (efs-ftp-path name)))
|
|
|
7205 file-name-handler-alist)
|
|
|
7206 (if (or (string-equal path "")
|
|
|
7207 (and (= (string-to-char path) ?~)
|
|
|
7208 (not
|
|
|
7209 (efs-save-match-data
|
|
|
7210 (string-match "/" path 1)))))
|
|
|
7211 name
|
|
|
7212 (if (efs-save-match-data
|
|
|
7213 (not (string-match "/" path)))
|
|
|
7214 (efs-replace-path-component name "")
|
|
|
7215 (file-name-directory name)))))
|
|
|
7216
|
|
|
7217 (defun efs-file-name-nondirectory (name)
|
|
|
7218 ;; Computes file-name-nondirectory for remote files.
|
|
|
7219 ;; For expanded filenames, can just call efs-internal-file-name-nondirectory.
|
|
|
7220 (let ((file (nth 2 (efs-ftp-path name))))
|
|
|
7221 (if (or (string-equal file "")
|
|
|
7222 (and (= (string-to-char file) ?~)
|
|
|
7223 (not
|
|
|
7224 (efs-save-match-data
|
|
|
7225 (string-match "/" file 1)))))
|
|
|
7226 ""
|
|
|
7227 (if (efs-save-match-data
|
|
|
7228 (not (string-match "/" file)))
|
|
|
7229 file
|
|
|
7230 (efs-internal-file-name-nondirectory name)))))
|
|
|
7231
|
|
|
7232 (defun efs-internal-file-name-nondirectory (name)
|
|
|
7233 ;; Version of file-name-nondirectory, without the efs-file-handler-function.
|
|
|
7234 ;; Useful to call this, if we have already decomposed the filename.
|
|
|
7235 (let (file-name-handler-alist)
|
|
|
7236 (file-name-nondirectory name)))
|
|
|
7237
|
|
|
7238 (defun efs-directory-file-name (dir)
|
|
|
7239 ;; Computes directory-file-name for remote files.
|
|
|
7240 ;; Needs to be careful not to turn /foo@bar:/ into /foo@bar:
|
|
|
7241 (let ((parsed (efs-ftp-path dir)))
|
|
|
7242 (if (string-equal "/" (nth 2 parsed))
|
|
|
7243 dir
|
|
|
7244 (efs-internal-directory-file-name dir))))
|
|
|
7245
|
|
|
7246 (defun efs-internal-directory-file-name (dir)
|
|
|
7247 ;; Call this if you want to apply directory-file-name to the remote
|
|
|
7248 ;; part of a efs-style path. Don't call for non-efs-style paths,
|
|
|
7249 ;; as this short-circuits the file-name-handler-alist completely.
|
|
|
7250 (let (file-name-handler-alist)
|
|
|
7251 (directory-file-name dir)))
|
|
|
7252
|
|
|
7253 (efs-defun efs-remote-directory-file-name nil (dir)
|
|
|
7254 "Returns the file name on the remote system of directory DIR.
|
|
|
7255 If the remote system is not unix, this may not be the same as the file name
|
|
|
7256 of the directory in efs's internal cache."
|
|
|
7257 (directory-file-name dir))
|
|
|
7258
|
|
|
7259 (defun efs-file-name-sans-versions (filename &optional keep-backup-versions)
|
|
|
7260 ;; Version of file-name-sans-versions for remote files.
|
|
|
7261 (or (file-name-absolute-p filename)
|
|
|
7262 (setq filename (expand-file-name filename)))
|
|
|
7263 (let ((parsed (efs-ftp-path filename)))
|
|
|
7264 (efs-internal-file-name-sans-versions
|
|
|
7265 (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7266 filename keep-backup-versions)))
|
|
|
7267
|
|
|
7268 (efs-defun efs-internal-file-name-sans-versions nil
|
|
|
7269 (filename &optional keep-backup-versions)
|
|
|
7270 (let (file-name-handler-alist)
|
|
|
7271 (file-name-sans-versions filename keep-backup-versions)))
|
|
|
7272
|
|
|
7273 (defun efs-diff-latest-backup-file (fn)
|
|
|
7274 ;; Version of diff latest backup file for remote files.
|
|
|
7275 ;; Accomodates non-unix.
|
|
|
7276 ;; Returns the latest backup for fn, according to the numbering
|
|
|
7277 ;; of the backups. Does not check file-newer-than-file-p.
|
|
|
7278 (let ((parsed (efs-ftp-path fn)))
|
|
|
7279 (efs-internal-diff-latest-backup-file
|
|
|
7280 (efs-host-type (car parsed) (nth 1 parsed)) fn)))
|
|
|
7281
|
|
|
7282 (efs-defun efs-internal-diff-latest-backup-file nil (fn)
|
|
|
7283 ;; Default behaviour is the behaviour in diff.el
|
|
|
7284 (let (file-name-handler-alist)
|
|
|
7285 (diff-latest-backup-file fn)))
|
|
|
7286
|
|
|
7287 (defun efs-unhandled-file-name-directory (filename)
|
|
|
7288 ;; Calculate a default unhandled directory for an efs buffer.
|
|
|
7289 ;; This is used to compute directories in which to execute
|
|
|
7290 ;; processes. This is relevant to V19 only. Doesn't do any harm for
|
|
|
7291 ;; older versions though. It would be nice if this wasn't such a
|
|
|
7292 ;; kludge.
|
|
|
7293 (file-name-directory efs-tmp-name-template))
|
|
|
7294
|
|
|
7295 (defun efs-file-truename (filename)
|
|
|
7296 ;; Calculates a remote file's truename, if this isn't inhibited.
|
|
|
7297 (let ((filename (expand-file-name filename)))
|
|
|
7298 (if (and efs-compute-remote-buffer-file-truename
|
|
|
7299 (memq (efs-host-type (car (efs-ftp-path filename)))
|
|
|
7300 efs-unix-host-types))
|
|
|
7301 (efs-internal-file-truename filename)
|
|
|
7302 filename)))
|
|
|
7303
|
|
|
7304 (defun efs-internal-file-truename (filename)
|
|
|
7305 ;; Internal function so that we don't keep checking
|
|
|
7306 ;; efs-compute-remote-buffer-file-truename, etc, as we recurse.
|
|
|
7307 (let ((dir (efs-file-name-directory filename))
|
|
|
7308 target dirfile)
|
|
|
7309 ;; Get the truename of the directory.
|
|
|
7310 (setq dirfile (efs-directory-file-name dir))
|
|
|
7311 ;; If these are equal, we have the (or a) root directory.
|
|
|
7312 (or (string= dir dirfile)
|
|
|
7313 (setq dir (efs-file-name-as-directory
|
|
|
7314 (efs-internal-file-truename dirfile))))
|
|
|
7315 (if (equal ".." (efs-file-name-nondirectory filename))
|
|
|
7316 (efs-directory-file-name (efs-file-name-directory
|
|
|
7317 (efs-directory-file-name dir)))
|
|
|
7318 (if (equal "." (efs-file-name-nondirectory filename))
|
|
|
7319 (efs-directory-file-name dir)
|
|
|
7320 ;; Put it back on the file name.
|
|
|
7321 (setq filename (concat dir (efs-file-name-nondirectory filename)))
|
|
|
7322 ;; Is the file name the name of a link?
|
|
|
7323 (setq target (efs-file-symlink-p filename))
|
|
|
7324 (if target
|
|
|
7325 ;; Yes => chase that link, then start all over
|
|
|
7326 ;; since the link may point to a directory name that uses links.
|
|
|
7327 ;; We can't safely use expand-file-name here
|
|
|
7328 ;; since target might look like foo/../bar where foo
|
|
|
7329 ;; is itself a link. Instead, we handle . and .. above.
|
|
|
7330 (if (file-name-absolute-p target)
|
|
|
7331 (efs-internal-file-truename target)
|
|
|
7332 (efs-internal-file-truename (concat dir target)))
|
|
|
7333 ;; No, we are done!
|
|
|
7334 filename)))))
|
|
|
7335
|
|
|
7336
|
|
|
7337 ;;;; ----------------------------------------------------------------
|
|
|
7338 ;;;; I/O functions
|
|
|
7339 ;;;; ----------------------------------------------------------------
|
|
|
7340
|
|
|
7341 (efs-define-fun efs-set-buffer-file-name (filename)
|
|
|
7342 ;; Sets the buffer local variables for filename appropriately.
|
|
|
7343 ;; A special function because Lucid and FSF do this differently.
|
|
|
7344 ;; This default behaviour is the lowest common denominator.
|
|
|
7345 (setq buffer-file-name filename))
|
|
|
7346
|
|
|
7347 (defun efs-write-region (start end filename &optional append visit &rest args)
|
|
|
7348 ;; write-region for remote files.
|
|
|
7349 ;; This version accepts the V19 interpretation for the arg VISIT.
|
|
|
7350 ;; However, making use of this within V18 may cause errors to crop up.
|
|
|
7351 ;; ARGS should catch the MULE coding-system argument.
|
|
|
7352 (if (stringp visit) (setq visit (expand-file-name visit)))
|
|
|
7353 (setq filename (expand-file-name filename))
|
|
|
7354 (let ((parsed (efs-ftp-path filename))
|
|
|
7355 ;; Make sure that the after-write-region-hook isn't called inside
|
|
|
7356 ;; the file-handler-alist
|
|
|
7357 (after-write-region-hook nil))
|
|
|
7358 (if parsed
|
|
|
7359 (let* ((host (car parsed))
|
|
|
7360 (user (nth 1 parsed))
|
|
|
7361 (host-type (efs-host-type host user))
|
|
|
7362 (temp (car (efs-make-tmp-name nil host)))
|
|
|
7363 (type (efs-xfer-type nil nil host-type filename))
|
|
|
7364 (abbr (and (or (stringp visit) (eq t visit) (null visit))
|
|
|
7365 (efs-relativize-filename
|
|
|
7366 (if (stringp visit) visit filename))))
|
|
|
7367 (buffer (current-buffer))
|
|
|
7368 (b-file-name buffer-file-name)
|
|
|
7369 (mod-p (buffer-modified-p)))
|
|
|
7370 (unwind-protect
|
|
|
7371 (progn
|
|
|
7372 (condition-case err
|
|
|
7373 (progn
|
|
|
7374 (unwind-protect
|
|
|
7375 (let ((executing-macro t))
|
|
|
7376 ;; let-bind executing-macro to inhibit messaging.
|
|
|
7377 ;; Setting VISIT to 'quiet is more elegant.
|
|
|
7378 ;; But in Emacs 18, doing it this way allows
|
|
|
7379 ;; us to modify the visited file modtime, so
|
|
|
7380 ;; that undo's show the buffer modified.
|
|
|
7381 (apply 'write-region start end
|
|
|
7382 temp nil visit args))
|
|
|
7383 ;; buffer-modified-p is now correctly set
|
|
|
7384 (setq buffer-file-name b-file-name)
|
|
|
7385 ;; File modtime is bogus, so clear.
|
|
|
7386 (clear-visited-file-modtime))
|
|
|
7387 (efs-copy-file-internal
|
|
|
7388 temp nil filename parsed (if append 'append t)
|
|
|
7389 nil (and abbr (format "Writing %s" abbr))
|
|
|
7390 ;; cont
|
|
|
7391 (efs-cont (result line cont-lines) (filename buffer
|
|
|
7392 visit)
|
|
|
7393 (if result
|
|
|
7394 (signal 'ftp-error
|
|
|
7395 (list "Opening output file"
|
|
|
7396 (format "FTP Error: \"%s\"" line)
|
|
|
7397 filename)))
|
|
|
7398 ;; The new file entry will be added by
|
|
|
7399 ;; efs-copy-file-internal.
|
|
|
7400 (cond
|
|
|
7401 ((eq visit t)
|
|
|
7402 ;; This will run asynch.
|
|
|
7403 (efs-save-buffer-excursion
|
|
|
7404 (set-buffer buffer)
|
|
|
7405 (efs-set-buffer-file-name filename)
|
|
|
7406 (efs-set-visited-file-modtime)))
|
|
|
7407 ((stringp visit)
|
|
|
7408 (efs-save-buffer-excursion
|
|
|
7409 (set-buffer buffer)
|
|
|
7410 (efs-set-buffer-file-name visit)
|
|
|
7411 (set-visited-file-modtime)))))
|
|
|
7412 nil type))
|
|
|
7413 (error
|
|
|
7414 ;; restore buffer-modified-p
|
|
|
7415 (let (file-name-handler-alist)
|
|
|
7416 (set-buffer-modified-p mod-p))
|
|
|
7417 (signal (car err) (cdr err))))
|
|
|
7418 (if (or (eq visit t)
|
|
|
7419 (and (stringp visit)
|
|
|
7420 (efs-ftp-path visit)))
|
|
|
7421 (efs-set-buffer-mode)))
|
|
|
7422 (efs-del-tmp-name temp))
|
|
|
7423 (and abbr (efs-message "Wrote %s" abbr)))
|
|
|
7424 (if (and (stringp visit) (efs-ftp-path visit))
|
|
|
7425 (progn
|
|
|
7426 (apply 'write-region start end filename append visit args)
|
|
|
7427 (efs-set-buffer-file-name visit)
|
|
|
7428 (efs-set-visited-file-modtime)
|
|
|
7429 (efs-set-buffer-mode))
|
|
|
7430 (error "efs-write-region called for a local file")))))
|
|
|
7431
|
|
|
7432 (defun efs-insert-file-contents (filename &optional visit &rest args)
|
|
|
7433 ;; Inserts file contents for remote files.
|
|
|
7434 ;; The additional ARGS covers V19 BEG and END. Should also handle the
|
|
|
7435 ;; CODING-SYSTEM arg for mule. Hope the two don't trip over each other.
|
|
|
7436 (barf-if-buffer-read-only)
|
|
|
7437 (unwind-protect
|
|
|
7438 (let* ((filename (expand-file-name filename))
|
|
|
7439 (parsed (efs-ftp-path filename))
|
|
|
7440 (host (car parsed))
|
|
|
7441 (host-type (efs-host-type host))
|
|
|
7442 (user (nth 1 parsed))
|
|
|
7443 (path (nth 2 parsed))
|
|
|
7444 (buffer (current-buffer)))
|
|
|
7445
|
|
|
7446 (if (or (file-exists-p filename)
|
|
|
7447 (let* ((res (and
|
|
|
7448 (not (efs-get-host-property host 'rnfr-failed))
|
|
|
7449 (efs-send-cmd
|
|
|
7450 host user (list 'quote 'rnfr path))))
|
|
|
7451 (line (nth 1 res)))
|
|
|
7452 ;; RNFR returns a 550 if the file doesn't exist.
|
|
|
7453 (if (and line (>= (length line) 4)
|
|
|
7454 (string-equal "550 " (substring line 0 4)))
|
|
|
7455 nil
|
|
|
7456 (if (car res) (efs-set-host-property host 'rnfr-failed t))
|
|
|
7457 (efs-del-from-ls-cache filename t nil)
|
|
|
7458 (efs-del-hash-entry
|
|
|
7459 (efs-canonize-file-name (file-name-directory filename))
|
|
|
7460 efs-files-hashtable)
|
|
|
7461 (file-exists-p filename))))
|
|
|
7462
|
|
|
7463 (let ((temp (concat
|
|
|
7464 (car (efs-make-tmp-name nil host))
|
|
|
7465 (efs-internal-file-name-extension filename)))
|
|
|
7466 (type (efs-xfer-type host-type filename nil nil))
|
|
|
7467 (abbr (efs-relativize-filename filename))
|
|
|
7468 (i-f-c-size 0))
|
|
|
7469
|
|
|
7470 (unwind-protect
|
|
|
7471 (efs-copy-file-internal
|
|
|
7472 filename parsed temp nil t nil
|
|
|
7473 (format "Retrieving %s" abbr)
|
|
|
7474 (efs-cont (result line cont-lines) (filename visit buffer
|
|
|
7475 host-type
|
|
|
7476 temp args)
|
|
|
7477 (if result
|
|
|
7478 (signal 'ftp-error
|
|
|
7479 (list "Opening input file"
|
|
|
7480 (format "FTP Error: \"%s\""
|
|
|
7481 line)
|
|
|
7482 filename))
|
|
|
7483 (if (eq host-type 'coke)
|
|
|
7484 (efs-coke-insert-beverage-contents buffer filename
|
|
|
7485 line)
|
|
|
7486 (efs-save-buffer-excursion
|
|
|
7487 (set-buffer buffer)
|
|
|
7488 (if (or (file-readable-p temp)
|
|
|
7489 (sleep-for efs-retry-time)
|
|
|
7490 ;; Wait for file to hopefully appear.
|
|
|
7491 (file-readable-p temp))
|
|
|
7492
|
|
|
7493 (setq i-f-c-size
|
|
|
7494 (nth 1 (apply 'insert-file-contents
|
|
|
7495 temp visit args)))
|
|
|
7496 (signal 'ftp-error
|
|
|
7497 (list
|
|
|
7498 "Opening input file:"
|
|
|
7499 (format
|
|
|
7500 "FTP Error: %s not arrived or readable"
|
|
|
7501 filename))))
|
|
|
7502 ;; This is done asynch
|
|
|
7503 (if visit
|
|
|
7504 (let ((buffer-file-name filename))
|
|
|
7505 (efs-set-visited-file-modtime)))))))
|
|
|
7506 nil type)
|
|
|
7507 (efs-del-tmp-name temp))
|
|
|
7508 ;; Return (FILENAME SIZE)
|
|
|
7509 (list filename i-f-c-size))
|
|
|
7510 (signal 'file-error (list "Opening input file" filename))))
|
|
|
7511 ;; Set buffer-file-name at the very last, so if anything bombs, we're
|
|
|
7512 ;; not visiting.
|
|
|
7513 (if visit
|
|
|
7514 (efs-set-buffer-file-name filename))))
|
|
|
7515
|
|
|
7516 (defun efs-revert-buffer (arg noconfirm)
|
|
|
7517 "Revert this buffer from a remote file using ftp."
|
|
|
7518 (let ((opoint (point)))
|
|
|
7519 (cond ((null buffer-file-name)
|
|
|
7520 (error "Buffer does not seem to be associated with any file"))
|
|
|
7521 ((or noconfirm
|
|
|
7522 (yes-or-no-p (format "Revert buffer from file %s? "
|
|
|
7523 buffer-file-name)))
|
|
|
7524 (let ((buffer-read-only nil))
|
|
|
7525 ;; Set buffer-file-name to nil
|
|
|
7526 ;; so that we don't try to lock the file.
|
|
|
7527 (let ((buffer-file-name nil))
|
|
|
7528 (unlock-buffer)
|
|
|
7529 (erase-buffer))
|
|
|
7530 (insert-file-contents buffer-file-name t))
|
|
|
7531 (goto-char (min opoint (point-max)))
|
|
|
7532 (after-find-file nil)
|
|
|
7533 t))))
|
|
|
7534
|
|
|
7535 (defun efs-recover-file (file)
|
|
|
7536 ;; Version of recover file for remote files, and remote autosave files too.
|
|
|
7537 (if (auto-save-file-name-p file) (error "%s is an auto-save file" file))
|
|
|
7538 (let* ((file-name (let ((buffer-file-name file)) (make-auto-save-file-name)))
|
|
|
7539 (file-name-parsed (efs-ftp-path file-name))
|
|
|
7540 (file-parsed (efs-ftp-path file))
|
|
|
7541 (efs-ls-uncache t))
|
|
|
7542 (cond ((not (file-newer-than-file-p file-name file))
|
|
|
7543 (error "Auto-save file %s not current" file-name))
|
|
|
7544 ((save-window-excursion
|
|
|
7545 (or (eq system-type 'vax-vms)
|
|
|
7546 (progn
|
|
|
7547 (with-output-to-temp-buffer "*Directory*"
|
|
|
7548 (buffer-disable-undo standard-output)
|
|
|
7549 (if file-parsed
|
|
|
7550 (progn
|
|
|
7551 (princ (format "On the host %s:\n"
|
|
|
7552 (car file-parsed)))
|
|
|
7553 (princ
|
|
|
7554 (let ((default-directory exec-directory))
|
|
|
7555 (efs-ls file (if (file-symlink-p file)
|
|
|
7556 "-lL" "-l")
|
|
|
7557 t t))))
|
|
|
7558 (princ "On the local host:\n")
|
|
|
7559 (let ((default-directory exec-directory))
|
|
|
7560 (call-process "ls" nil standard-output nil
|
|
|
7561 (if (file-symlink-p file) "-lL" "-l")
|
|
|
7562 file)))
|
|
|
7563 (princ "\nAUTO SAVE FILE on the ")
|
|
|
7564 (if file-name-parsed
|
|
|
7565 (progn
|
|
|
7566 (princ (format "host %s:\n"
|
|
|
7567 (car file-name-parsed)))
|
|
|
7568 (princ
|
|
|
7569 (efs-ls file-name
|
|
|
7570 (if (file-symlink-p file-name) "-lL" "-l")
|
|
|
7571 t t)))
|
|
|
7572 (princ "local host:\n")
|
|
|
7573 (let ((default-directory exec-directory))
|
|
|
7574 (call-process "ls" nil standard-output nil
|
|
|
7575 "-l" file-name)))
|
|
|
7576 (princ "\nFile modification times are given in ")
|
|
|
7577 (princ "the local time of each host.\n"))
|
|
|
7578 (save-excursion
|
|
|
7579 (set-buffer "*Directory*")
|
|
|
7580 (goto-char (point-min))
|
|
|
7581 (while (not (eobp))
|
|
|
7582 (end-of-line)
|
|
|
7583 (if (> (current-column) (window-width))
|
|
|
7584 (progn
|
|
|
7585 (skip-chars-backward " \t")
|
|
|
7586 (skip-chars-backward "^ \t\n")
|
|
|
7587 (if (> (current-column) 12)
|
|
|
7588 (progn
|
|
|
7589 (delete-horizontal-space)
|
|
|
7590 (insert "\n ")))))
|
|
|
7591 (forward-line 1))
|
|
|
7592 (set-buffer-modified-p nil)
|
|
|
7593 (goto-char (point-min)))))
|
|
|
7594 (yes-or-no-p (format "Recover using this auto save file? ")))
|
|
|
7595 (switch-to-buffer (find-file-noselect file t))
|
|
|
7596 (let ((buffer-read-only nil))
|
|
|
7597 (erase-buffer)
|
|
|
7598 (insert-file-contents file-name nil))
|
|
|
7599 (after-find-file nil))
|
|
|
7600 (t (error "Recover-file cancelled."))))
|
|
|
7601 ;; This is no longer done in V19. However, I like the caution for
|
|
|
7602 ;; remote files, where file-newer-than-file-p may lie.
|
|
|
7603 (setq buffer-auto-save-file-name nil)
|
|
|
7604 (message "Auto-save off in this buffer till you do M-x auto-save-mode."))
|
|
|
7605
|
|
|
7606 ;;;; ------------------------------------------------------------------
|
|
|
7607 ;;;; Attributes of files.
|
|
|
7608 ;;;; ------------------------------------------------------------------
|
|
|
7609
|
|
|
7610 (defun efs-file-symlink-p (file)
|
|
|
7611 ;; Version of file-symlink-p for remote files.
|
|
|
7612 ;; Call efs-expand-file-name rather than the normal
|
|
|
7613 ;; expand-file-name to stop loops when using a package that
|
|
|
7614 ;; redefines both file-symlink-p and expand-file-name.
|
|
|
7615 ;; Do not use efs-get-file-entry, because a child-lookup won't do.
|
|
|
7616 (let* ((file (efs-expand-file-name file))
|
|
|
7617 (ignore-case (memq (efs-host-type (car (efs-ftp-path file)))
|
|
|
7618 efs-case-insensitive-host-types))
|
|
|
7619 (file-type (car (efs-get-hash-entry
|
|
|
7620 (efs-get-file-part file)
|
|
|
7621 (efs-get-files (file-name-directory file))
|
|
|
7622 ignore-case))))
|
|
|
7623 (and (stringp file-type)
|
|
|
7624 (if (file-name-absolute-p file-type)
|
|
|
7625 (efs-replace-path-component file file-type)
|
|
|
7626 file-type))))
|
|
|
7627
|
|
|
7628 (defun efs-file-exists-p (path)
|
|
|
7629 ;; file-exists-p for remote file. Uses the cache if possible.
|
|
|
7630 (let* ((path (expand-file-name path))
|
|
|
7631 (parsed (efs-ftp-path path)))
|
|
|
7632 (efs-internal-file-exists-p (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7633 path)))
|
|
|
7634
|
|
|
7635 (efs-defun efs-internal-file-exists-p nil (path)
|
|
|
7636 (and (efs-get-file-entry path) t))
|
|
|
7637
|
|
|
7638 (defun efs-file-directory-p (file)
|
|
|
7639 (let* ((file (expand-file-name file))
|
|
|
7640 (parsed (efs-ftp-path file)))
|
|
|
7641 (efs-internal-file-directory-p (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7642 file)))
|
|
|
7643
|
|
|
7644 (efs-defun efs-internal-file-directory-p nil (path)
|
|
|
7645 ;; Version of file-directory-p for remote files.
|
|
|
7646 (let ((parsed (efs-ftp-path path)))
|
|
|
7647 (or (string-equal (nth 2 parsed) "/") ; root is always a directory
|
|
|
7648 (let ((file-ent (car (efs-get-file-entry
|
|
|
7649 (efs-internal-file-name-as-directory
|
|
|
7650 (efs-host-type (car parsed) (nth 1 parsed))
|
|
|
7651 path)))))
|
|
|
7652 ;; We do a file-name-as-directory on path here because some
|
|
|
7653 ;; machines (VMS) use a .DIR to indicate the filename associated
|
|
|
7654 ;; with a directory. This needs to be canonicalized.
|
|
|
7655 (if (stringp file-ent)
|
|
|
7656 (efs-internal-file-directory-p
|
|
|
7657 nil
|
|
|
7658 (efs-chase-symlinks
|
|
|
7659 ;; efs-internal-directory-file-name
|
|
|
7660 ;; only loses for paths where the remote file
|
|
|
7661 ;; is /. This has been eliminated.
|
|
|
7662 (efs-internal-directory-file-name path)))
|
|
|
7663 file-ent)))))
|
|
|
7664
|
|
|
7665 (defun efs-file-attributes (file)
|
|
|
7666 ;; Returns file-file-attributes for a remote file.
|
|
|
7667 ;; For the file modtime does not return efs's cached value, as that
|
|
|
7668 ;; corresponds to buffer-file-modtime (i.e. the modtime of the file
|
|
|
7669 ;; the last time the buffer was vsisted or saved). Caching modtimes
|
|
|
7670 ;; does not make much sense, as they are usually used to determine
|
|
|
7671 ;; if a cache is stale. The modtime if a remote file can be obtained with
|
|
|
7672 ;; efs-get-file-mdtm. This is _not_ returned for the 5th entry here,
|
|
|
7673 ;; because it requires an FTP transaction, and a priori we don't know
|
|
|
7674 ;; if the caller actually cares about this info. Having file-attributes
|
|
|
7675 ;; return such a long list of info is not well suited to remote files,
|
|
|
7676 ;; as some of this info may be costly to obtain.
|
|
|
7677 (let* ((file (expand-file-name file))
|
|
|
7678 (ent (efs-get-file-entry file)))
|
|
|
7679 (if ent
|
|
|
7680 (let* ((parsed (efs-ftp-path file))
|
|
|
7681 (host (nth 0 parsed))
|
|
|
7682 (user (nth 1 parsed))
|
|
|
7683 (path (nth 2 parsed))
|
|
|
7684 (type (car ent))
|
|
|
7685 (size (or (nth 1 ent) -1))
|
|
|
7686 (owner (nth 2 ent))
|
|
|
7687 (modes (nth 3 ent))
|
|
|
7688 ;; Hack to give remote files a "unique" "inode number".
|
|
|
7689 ;; It's actually the sum of the characters in its name.
|
|
|
7690 ;; It's not even really unique.
|
|
|
7691 (inode (apply '+
|
|
|
7692 (nconc (mapcar 'identity host)
|
|
|
7693 (mapcar 'identity user)
|
|
|
7694 (mapcar 'identity
|
|
|
7695 (efs-internal-directory-file-name
|
|
|
7696 path)))))
|
|
|
7697 (nlinks (or (nth 4 ent) -1))) ; return -1 if we don't know
|
|
|
7698 (list
|
|
|
7699 (if (and (stringp type) (file-name-absolute-p type))
|
|
|
7700 (efs-replace-path-component file type)
|
|
|
7701 type) ;0 file type
|
|
|
7702 nlinks ;1 link count
|
|
|
7703 (if owner ;2 uid
|
|
|
7704 ;; Not really a unique integer,
|
|
|
7705 ;; just a half-hearted attempt
|
|
|
7706 (apply '+ (mapcar 'identity owner))
|
|
|
7707 -1)
|
|
|
7708 -1 ;3 gid
|
|
|
7709 '(0 0) ;4 atime
|
|
|
7710 '(0 0) ;5 mtime
|
|
|
7711 '(0 0) ;6 ctime
|
|
|
7712 size ;7 size
|
|
|
7713 (or modes ;8 mode
|
|
|
7714 (concat
|
|
|
7715 (cond ((stringp type) "l")
|
|
|
7716 (type "d")
|
|
|
7717 (t "-"))
|
|
|
7718 "?????????"))
|
|
|
7719 nil ;9 gid weird (Who knows if the gid
|
|
|
7720 ; would be changed?)
|
|
|
7721 inode ;10 inode
|
|
|
7722 -1 ;11 device number [v19 only]
|
|
|
7723 )))))
|
|
|
7724
|
|
|
7725 (defun efs-file-writable-p (file)
|
|
|
7726 ;; file-writable-p for remote files.
|
|
|
7727 ;; Does not attempt to open the file, but just looks at the cached file
|
|
|
7728 ;; modes.
|
|
|
7729 (let* ((file (expand-file-name file))
|
|
|
7730 (ent (efs-get-file-entry file)))
|
|
|
7731 (if (and ent (or (not (stringp (car ent)))
|
|
|
7732 (setq file (efs-chase-symlinks file)
|
|
|
7733 ent (efs-get-file-entry file))))
|
|
|
7734 (let* ((owner (nth 2 ent))
|
|
|
7735 (modes (nth 3 ent))
|
|
|
7736 (parsed (efs-ftp-path file))
|
|
|
7737 (host-type (efs-host-type (car parsed)))
|
|
|
7738 (user (nth 1 parsed)))
|
|
|
7739 (if (memq host-type efs-unix-host-types)
|
|
|
7740 (setq host-type 'unix))
|
|
|
7741 (efs-internal-file-writable-p host-type user owner modes))
|
|
|
7742 (let ((dir (file-name-directory file)))
|
|
|
7743 (and
|
|
|
7744 (not (string-equal dir file))
|
|
|
7745 (file-directory-p dir)
|
|
|
7746 (file-writable-p dir))))))
|
|
|
7747
|
|
|
7748 (efs-defun efs-internal-file-writable-p nil (user owner modes)
|
|
|
7749 ;; By default, we'll just guess yes.
|
|
|
7750 t)
|
|
|
7751
|
|
|
7752 (efs-defun efs-internal-file-writable-p unix (user owner modes)
|
|
|
7753 (if (and modes
|
|
|
7754 (not (string-equal user "root")))
|
|
|
7755 (null
|
|
|
7756 (null
|
|
|
7757 (if (string-equal user owner)
|
|
|
7758 (memq ?w (list (aref modes 2) (aref modes 5)
|
|
|
7759 (aref modes 8)))
|
|
|
7760 (memq ?w (list (aref modes 5) (aref modes 8))))))
|
|
|
7761 t)) ; guess
|
|
|
7762
|
|
|
7763 (defun efs-file-readable-p (file)
|
|
|
7764 ;; Version of file-readable-p that works for remote files.
|
|
|
7765 ;; Works by checking efs's cache of the file modes.
|
|
|
7766 (let* ((file (expand-file-name file))
|
|
|
7767 (ent (efs-get-file-entry file)))
|
|
|
7768 (and ent
|
|
|
7769 (or (not (stringp (car ent)))
|
|
|
7770 (setq ent (efs-get-file-entry (efs-chase-symlinks file))))
|
|
|
7771 ;; file exists
|
|
|
7772 (let* ((parsed (efs-ftp-path file))
|
|
|
7773 (owner (nth 2 ent))
|
|
|
7774 (modes (nth 3 ent))
|
|
|
7775 (host-type (efs-host-type (car parsed)))
|
|
|
7776 (user (nth 1 parsed)))
|
|
|
7777 (if (memq host-type efs-unix-host-types)
|
|
|
7778 (setq host-type 'unix))
|
|
|
7779 (efs-internal-file-readable-p host-type user owner modes)))))
|
|
|
7780
|
|
|
7781 (efs-defun efs-internal-file-readable-p nil (user owner modes)
|
|
|
7782 ;; Guess t by default
|
|
|
7783 t)
|
|
|
7784
|
|
|
7785 (efs-defun efs-internal-file-readable-p unix (user owner modes)
|
|
|
7786 (if (and modes
|
|
|
7787 (not (string-equal user "root")))
|
|
|
7788 (null
|
|
|
7789 (null
|
|
|
7790 (if (string-equal user owner)
|
|
|
7791 (memq ?r (list (aref modes 1) (aref modes 4)
|
|
|
7792 (aref modes 7)))
|
|
|
7793 (memq ?r (list (aref modes 4) (aref modes 7))))))
|
|
|
7794 t)) ; guess
|
|
|
7795
|
|
|
7796 (defun efs-file-executable-p (file)
|
|
|
7797 ;; Version of file-executable-p for remote files.
|
|
|
7798 (let ((ent (efs-get-file-entry file)))
|
|
|
7799 (and ent
|
|
|
7800 (or (not (stringp (car ent)))
|
|
|
7801 (setq ent (efs-get-file-entry (efs-chase-symlinks file))))
|
|
|
7802 ;; file exists
|
|
|
7803 (let* ((parsed (efs-ftp-path file))
|
|
|
7804 (owner (nth 2 ent))
|
|
|
7805 (modes (nth 3 ent))
|
|
|
7806 (host-type (efs-host-type (car parsed)))
|
|
|
7807 (user (nth 1 parsed)))
|
|
|
7808 (if (memq host-type efs-unix-host-types)
|
|
|
7809 (setq host-type 'unix))
|
|
|
7810 (efs-internal-file-executable-p host-type user owner modes)))))
|
|
|
7811
|
|
|
7812 (efs-defun efs-internal-file-executable-p nil (user owner modes)
|
|
|
7813 ;; Guess t by default
|
|
|
7814 t)
|
|
|
7815
|
|
|
7816 (efs-defun efs-internal-file-executable-p unix (user owner modes)
|
|
|
7817 (if (and modes
|
|
|
7818 (not (string-equal user "root")))
|
|
|
7819 (null
|
|
|
7820 (null
|
|
|
7821 (if (string-equal user owner)
|
|
|
7822 (memq ?x (list (aref modes 3) (aref modes 6)
|
|
|
7823 (aref modes 9)))
|
|
|
7824 (memq ?x (list (aref modes 6) (aref modes 9))))))
|
|
|
7825 t)) ; guess
|
|
|
7826
|
|
|
7827 (defun efs-file-accessible-directory-p (dir)
|
|
|
7828 ;; Version of file-accessible-directory-p for remote directories.
|
|
|
7829 (let ((file (directory-file-name dir)))
|
|
|
7830 (and (efs-file-directory-p file) (efs-file-executable-p file))))
|
|
|
7831
|
|
|
7832 ;;;; --------------------------------------------------------------
|
|
|
7833 ;;;; Listing directories.
|
|
|
7834 ;;;; --------------------------------------------------------------
|
|
|
7835
|
|
|
7836 (defun efs-shell-regexp-to-regexp (regexp)
|
|
|
7837 ;; Converts a shell regexp to an emacs regexp.
|
|
|
7838 ;; Probably full of bugs. Tries to follow csh globbing.
|
|
|
7839 (let ((curly 0)
|
|
|
7840 backslash)
|
|
|
7841 (concat "^"
|
|
|
7842 (mapconcat
|
|
|
7843 (function
|
|
|
7844 (lambda (char)
|
|
|
7845 (cond
|
|
|
7846 (backslash
|
|
|
7847 (setq backslash nil)
|
|
|
7848 (regexp-quote (char-to-string char)))
|
|
|
7849 ((and (> curly 0) (eq char ?,))
|
|
|
7850 "\\|")
|
|
|
7851 ((memq char '(?[ ?]))
|
|
|
7852 (char-to-string char))
|
|
|
7853 ((eq char ??)
|
|
|
7854 ".")
|
|
|
7855 ((eq char ?\\)
|
|
|
7856 (setq backslash t)
|
|
|
7857 "")
|
|
|
7858 ((eq char ?*)
|
|
|
7859 ".*")
|
|
|
7860 ((eq char ?{)
|
|
|
7861 (setq curly (1+ curly))
|
|
|
7862 "\\(")
|
|
|
7863 ((and (eq char ?}) (> curly 0))
|
|
|
7864 (setq curly (1- curly))
|
|
|
7865 "\\)")
|
|
|
7866 (t (regexp-quote (char-to-string char))))))
|
|
|
7867 regexp nil)
|
|
|
7868 "$")))
|
|
|
7869
|
|
|
7870
|
|
|
7871 ;;; Getting directory listings.
|
|
|
7872
|
|
44
|
7873 (defun efs-directory-files (directory &optional full match nosort &rest ignored-for-now)
|
|
22
|
7874 ;; Returns directory-files for remote directories.
|
|
|
7875 ;; NOSORT is a V19 arg.
|
|
|
7876 (let* ((directory (expand-file-name directory))
|
|
|
7877 (parsed (efs-ftp-path directory))
|
|
|
7878 (directory (efs-internal-file-name-as-directory
|
|
|
7879 (efs-host-type (car parsed) (nth 1 parsed)) directory))
|
|
|
7880 files)
|
|
|
7881 (efs-barf-if-not-directory directory)
|
|
|
7882 (setq files (efs-hash-table-keys (efs-get-files directory) nosort))
|
|
|
7883 (cond
|
|
|
7884 ((null (or full match))
|
|
|
7885 files)
|
|
|
7886 (match ; this is slow case
|
|
|
7887 (let (res f)
|
|
|
7888 (efs-save-match-data
|
|
|
7889 (while files
|
|
|
7890 (setq f (if full (concat directory (car files)) (car files))
|
|
|
7891 files (cdr files))
|
|
|
7892 (if (string-match match f)
|
|
|
7893 (setq res (nconc res (list f))))))
|
|
|
7894 res))
|
|
|
7895 (full
|
|
|
7896 (mapcar (function
|
|
|
7897 (lambda (fn)
|
|
|
7898 (concat directory fn)))
|
|
|
7899 files)))))
|
|
|
7900
|
|
|
7901 (defun efs-list-directory (dirname &optional verbose)
|
|
|
7902 ;; Version of list-directory for remote directories.
|
|
|
7903 ;; If verbose is nil, it gets its information from efs's
|
|
|
7904 ;; internal cache.
|
|
|
7905 (let* ((dirname (expand-file-name (or dirname default-directory)))
|
|
|
7906 header)
|
|
|
7907 (if (file-directory-p dirname)
|
|
|
7908 (setq dirname (file-name-as-directory dirname)))
|
|
|
7909 (setq header dirname)
|
|
|
7910 (with-output-to-temp-buffer "*Directory*"
|
|
|
7911 (buffer-disable-undo standard-output)
|
|
|
7912 (princ "Directory ")
|
|
|
7913 (princ header)
|
|
|
7914 (terpri)
|
|
|
7915 (princ
|
|
|
7916 (efs-ls dirname (if verbose
|
|
|
7917 list-directory-verbose-switches
|
|
|
7918 list-directory-brief-switches)
|
|
|
7919 t)))))
|
|
|
7920
|
|
|
7921 ;;;; -------------------------------------------------------------------
|
|
|
7922 ;;;; Manipulating buffers.
|
|
|
7923 ;;;; -------------------------------------------------------------------
|
|
|
7924
|
|
|
7925 (defun efs-get-file-buffer (file)
|
|
|
7926 ;; Version of get-file-buffer for remote files. Needs to fuss over things
|
|
|
7927 ;; like OS's which are case-insens. for file names.
|
|
|
7928 (let ((file (efs-canonize-file-name (expand-file-name file)))
|
|
|
7929 (buff-list (buffer-list))
|
|
|
7930 buff-name)
|
|
|
7931 (catch 'match
|
|
|
7932 (while buff-list
|
|
|
7933 (and (setq buff-name (buffer-file-name (car buff-list)))
|
|
|
7934 (= (length buff-name) (length file)) ; efficiency hack
|
|
|
7935 (string-equal (efs-canonize-file-name buff-name) file)
|
|
|
7936 (throw 'match (car buff-list)))
|
|
|
7937 (setq buff-list (cdr buff-list))))))
|
|
|
7938
|
|
|
7939 (defun efs-create-file-buffer (filename)
|
|
|
7940 ;; Version of create-file-buffer for remote file names.
|
|
|
7941 (let* ((parsed (efs-ftp-path (expand-file-name filename)))
|
|
|
7942 (file (nth 2 parsed))
|
|
|
7943 (host (car parsed))
|
|
|
7944 (host-type (efs-host-type host))
|
|
|
7945 (buff (cond
|
|
|
7946 ((null efs-fancy-buffer-names)
|
|
|
7947 (if (string-equal file "/")
|
|
|
7948 "/"
|
|
|
7949 (efs-internal-file-name-nondirectory
|
|
|
7950 (efs-internal-directory-file-name file))))
|
|
|
7951 ((stringp efs-fancy-buffer-names)
|
|
|
7952 (format efs-fancy-buffer-names
|
|
|
7953 (if (string-equal file "/")
|
|
|
7954 "/"
|
|
|
7955 (efs-internal-file-name-nondirectory
|
|
|
7956 (efs-internal-directory-file-name file)))
|
|
|
7957 (substring host 0 (string-match "\\." host 1))))
|
|
|
7958 (t ; efs-fancy-buffer-names had better be a function
|
|
|
7959 (funcall efs-fancy-buffer-names host
|
|
|
7960 (nth 1 parsed) file)))))
|
|
|
7961 (if (memq host-type efs-case-insensitive-host-types)
|
|
|
7962 (cond ((eq efs-buffer-name-case 'down)
|
|
|
7963 (setq buff (downcase buff)))
|
|
|
7964 ((eq efs-buffer-name-case 'up)
|
|
|
7965 (setq buff (upcase buff)))))
|
|
|
7966 (get-buffer-create (generate-new-buffer-name buff))))
|
|
|
7967
|
|
|
7968 (defun efs-set-buffer-mode ()
|
|
|
7969 "Set correct modes for the current buffer if it is visiting a remote file."
|
|
|
7970 (if (and (stringp buffer-file-name)
|
|
|
7971 (efs-ftp-path buffer-file-name))
|
|
|
7972 (progn
|
|
|
7973 (auto-save-mode efs-auto-save)
|
|
|
7974 (set (make-local-variable 'revert-buffer-function)
|
|
|
7975 'efs-revert-buffer)
|
|
|
7976 (set (make-local-variable 'default-directory-function)
|
|
|
7977 'efs-default-dir-function))))
|
|
|
7978
|
|
|
7979 ;;;; ---------------------------------------------------------
|
|
|
7980 ;;;; Functions for doing backups.
|
|
|
7981 ;;;; ---------------------------------------------------------
|
|
|
7982
|
|
|
7983 (defun efs-backup-buffer ()
|
|
|
7984 ;; Version of backup-buffer for buffers visiting remote files.
|
|
|
7985 (if efs-make-backup-files
|
|
|
7986 (let* ((parsed (efs-ftp-path buffer-file-name))
|
|
|
7987 (host (car parsed))
|
|
|
7988 (host-type (efs-host-type (car parsed))))
|
|
|
7989 (if (or (not (listp efs-make-backup-files))
|
|
|
7990 (memq host-type efs-make-backup-files))
|
|
|
7991 (efs-internal-backup-buffer
|
|
|
7992 host host-type (nth 1 parsed) (nth 2 parsed))))))
|
|
|
7993
|
|
|
7994 (defun efs-internal-backup-buffer (host host-type user remote-path)
|
|
|
7995 ;; This is almost a copy of the function in files.el, modified
|
|
|
7996 ;; to check to see if the backup file exists, before deleting it.
|
|
|
7997 ;; It also supports efs-backup-by-copying, and tries to do the
|
|
|
7998 ;; right thing about backup-by-copying-when-mismatch. Only called
|
|
|
7999 ;; for remote files.
|
|
|
8000 ;; Set the umask now, so that `setmodes' knows about it.
|
|
|
8001 (efs-set-umask host user)
|
|
|
8002 (let ((ent (efs-get-file-entry (expand-file-name buffer-file-name)))
|
|
|
8003 ;; Never do version-control if the remote operating system is doing it.
|
|
|
8004 (version-control (if (memq host-type efs-version-host-types)
|
|
|
8005 'never
|
|
|
8006 version-control))
|
|
|
8007 modstring)
|
|
|
8008 (and make-backup-files
|
|
|
8009 (not buffer-backed-up)
|
|
|
8010 ent ; i.e. file-exists-p
|
|
|
8011 (not (eq t (car ent)))
|
|
|
8012 (or (null (setq modstring (nth 3 ent)))
|
|
|
8013 (not (memq host-type efs-unix-host-types))
|
|
|
8014 (memq (aref modstring 0) '(?- ?l)))
|
|
|
8015 (or (< (length remote-path) 5)
|
|
|
8016 (not (string-equal "/tmp/" (substring remote-path 0 5))))
|
|
|
8017 (condition-case ()
|
|
|
8018 (let* ((backup-info (find-backup-file-name buffer-file-name))
|
|
|
8019 (backupname (car backup-info))
|
|
|
8020 (targets (cdr backup-info))
|
|
|
8021 (links (nth 4 ent))
|
|
|
8022 setmodes)
|
|
|
8023 (condition-case ()
|
|
|
8024 (if (or file-precious-flag
|
|
|
8025 (stringp (car ent)) ; symlinkp
|
|
|
8026 efs-backup-by-copying
|
|
|
8027 (and backup-by-copying-when-linked
|
|
|
8028 links (> links 1))
|
|
|
8029 (and backup-by-copying-when-mismatch
|
|
|
8030 (not
|
|
|
8031 (if (memq
|
|
|
8032 host-type
|
|
|
8033 efs-case-insensitive-host-types)
|
|
|
8034 (string-equal
|
|
|
8035 (downcase user) (downcase (nth 2 ent)))
|
|
|
8036 (string-equal user (nth 2 ent))))))
|
|
|
8037 (copy-file buffer-file-name backupname t t)
|
|
|
8038 (condition-case ()
|
|
|
8039 (if (file-exists-p backupname)
|
|
|
8040 (delete-file backupname))
|
|
|
8041 (file-error nil))
|
|
|
8042 (rename-file buffer-file-name backupname t)
|
|
|
8043 (setq setmodes (file-modes backupname)))
|
|
|
8044 (file-error
|
|
|
8045 ;; If trouble writing the backup, write it in ~.
|
|
|
8046 (setq backupname (expand-file-name "~/%backup%~"))
|
|
|
8047 (message
|
|
|
8048 "Cannot write backup file; backing up in ~/%%backup%%~")
|
|
|
8049 (sleep-for 1)
|
|
|
8050 (copy-file buffer-file-name backupname t t)))
|
|
|
8051 (setq buffer-backed-up t)
|
|
|
8052 ;; Starting with 19.26, trim-versions-without-asking
|
|
|
8053 ;; has been renamed to delete-old-verions.
|
|
|
8054 (if (and targets
|
|
|
8055 (or (if (boundp 'trim-versions-without-asking)
|
|
|
8056 trim-versions-without-asking
|
|
|
8057 (and
|
|
|
8058 (boundp 'delete-old-versions)
|
|
|
8059 delete-old-versions))
|
|
|
8060 (y-or-n-p (format
|
|
|
8061 "Delete excess backup versions of %s? "
|
|
|
8062 buffer-file-name))))
|
|
|
8063 (while targets
|
|
|
8064 (condition-case ()
|
|
|
8065 (delete-file (car targets))
|
|
|
8066 (file-error nil))
|
|
|
8067 (setq targets (cdr targets))))
|
|
|
8068 ;; If the file was already written with the right modes,
|
|
|
8069 ;; don't return set-modes.
|
|
|
8070 (and setmodes
|
|
|
8071 (null
|
|
|
8072 (let ((buff (get-buffer
|
|
|
8073 (efs-ftp-process-buffer host user))))
|
|
|
8074 (and buff
|
|
|
8075 (save-excursion
|
|
|
8076 (set-buffer buff)
|
|
|
8077 (and (integerp efs-process-umask)
|
|
|
8078 (= (efs-modes-from-umask efs-process-umask)
|
|
|
8079 setmodes))))))
|
|
|
8080 setmodes))
|
|
|
8081 (file-error nil)))))
|
|
|
8082
|
|
|
8083 ;;;; ------------------------------------------------------------
|
|
|
8084 ;;;; Redefinition for Emacs file mode support
|
|
|
8085 ;;;; ------------------------------------------------------------
|
|
|
8086
|
|
|
8087 (defmacro efs-build-mode-string-element (int suid-p sticky-p)
|
|
|
8088 ;; INT is between 0 and 7.
|
|
|
8089 ;; If SUID-P is non-nil, we are building the 3-char string for either
|
|
|
8090 ;; the owner or group, and the s[ug]id bit is set.
|
|
|
8091 ;; If STICKY-P is non-nil, we are building the string for other perms,
|
|
|
8092 ;; and the sticky bit is set.
|
|
|
8093 ;; It doesn't make sense for both SUID-P and STICKY-P be non-nil!
|
|
|
8094 (` (let* ((int (, int))
|
|
|
8095 (suid-p (, suid-p))
|
|
|
8096 (sticky-p (, sticky-p))
|
|
|
8097 (read-bit (if (memq int '(4 5 6 7)) "r" "-"))
|
|
|
8098 (write-bit (if (memq int '(2 3 6 7)) "w" "-"))
|
|
|
8099 (x-bit (if (memq int '(1 3 5 7))
|
|
|
8100 (cond (suid-p "s") (sticky-p "t") ("x"))
|
|
|
8101 (cond (suid-p "S") (sticky-p "T") ("-")))))
|
|
|
8102 (concat read-bit write-bit x-bit))))
|
|
|
8103
|
|
|
8104 (defun efs-mode-string (int)
|
|
|
8105 ;; Takes an octal integer between 0 and 7777, and returns the 9 character
|
|
|
8106 ;; mode string.
|
|
|
8107 (let* ((other-int (% int 10))
|
|
|
8108 (int (/ int 10))
|
|
|
8109 (group-int (% int 10))
|
|
|
8110 (int (/ int 10))
|
|
|
8111 (owner-int (% int 10))
|
|
|
8112 (int (/ int 10))
|
|
|
8113 (suid (memq int '(4 5 6 7)))
|
|
|
8114 (sgid (memq int '(2 3 6 7)))
|
|
|
8115 (sticky (memq int '(1 3 5 7))))
|
|
|
8116 (concat (efs-build-mode-string-element owner-int suid nil)
|
|
|
8117 (efs-build-mode-string-element group-int sgid nil)
|
|
|
8118 (efs-build-mode-string-element other-int nil sticky))))
|
|
|
8119
|
|
48
|
8120 (defun efs-shell-call-process (command dir &optional in-background)
|
|
|
8121 ;; Runs shell process on remote hosts.
|
|
|
8122 (let* ((parsed (efs-ftp-path dir))
|
|
|
8123 (host (car parsed))
|
|
|
8124 (user (nth 1 parsed))
|
|
|
8125 (rdir (nth 2 parsed))
|
|
|
8126 (file-name-handler-alist nil))
|
|
|
8127 (or (string-equal (efs-internal-directory-file-name dir)
|
|
|
8128 (efs-expand-tilde "~" (efs-host-type host) host user))
|
|
|
8129 (string-match "^cd " command)
|
|
|
8130 (setq command (concat "cd " rdir "; " command)))
|
|
|
8131 (setq command
|
|
|
8132 (format "%s %s%s \"%s\"" ; remsh -l USER does not work well
|
|
|
8133 ; on a hp-ux machine I tried
|
|
|
8134 efs-remote-shell-file-name host
|
|
|
8135 (if efs-remote-shell-takes-user
|
|
|
8136 (concat " -l " user)
|
|
|
8137 "")
|
|
|
8138 command))
|
|
|
8139 (message "Doing shell command on %s..." host)
|
|
|
8140 ;; do it
|
|
|
8141 (let ((process-connection-type ; don't waste pty's
|
|
|
8142 (null (null in-background))))
|
|
|
8143 (setq default-directory (file-name-directory efs-tmp-name-template))
|
|
|
8144 (if in-background
|
|
|
8145 (progn
|
|
|
8146 (setq mode-line-process '(": %s"))
|
|
|
8147 (start-process "Shell" (current-buffer)
|
|
|
8148 shell-file-name "-c" command))
|
|
|
8149 (call-process shell-file-name nil t nil "-c" command)))))
|
|
|
8150
|
|
22
|
8151 (defun efs-set-file-modes (file mode)
|
|
|
8152 ;; set-file-modes for remote files.
|
|
|
8153 ;; For remote files, if mode is nil, does nothing.
|
|
|
8154 ;; This is because efs-file-modes returns nil if the modes
|
|
|
8155 ;; of a remote file couldn't be determined, even if the file exists.
|
|
|
8156 (and mode
|
|
|
8157 (let* ((file (expand-file-name file))
|
|
|
8158 (parsed (efs-ftp-path file))
|
|
|
8159 (host (car parsed))
|
|
|
8160 (user (nth 1 parsed))
|
|
|
8161 (r-file (nth 2 parsed))
|
|
|
8162 ;; convert to octal, and keep only 12 lowest order bits.
|
|
|
8163 (omode (format "%o" (- mode (lsh (lsh mode -12) 12)))))
|
|
|
8164 (if (or (efs-get-host-property host 'chmod-failed)
|
|
|
8165 (null (memq (efs-host-type host user) efs-unix-host-types)))
|
|
|
8166 (message "Unable to set file modes for %s to %s." file omode)
|
|
|
8167 (efs-send-cmd
|
|
|
8168 host user
|
|
|
8169 (list 'quote 'site 'chmod omode r-file)
|
|
|
8170 nil nil
|
|
|
8171 (efs-cont (result line cont-lines) (host file r-file omode)
|
|
|
8172 (if result
|
|
48
|
8173 (let ((exit-code
|
|
|
8174 (efs-shell-call-process
|
|
|
8175 (concat "chmod " mode " " (file-name-nondirectory file))
|
|
|
8176 (file-name-directory file))))
|
|
|
8177 (if (not (equal 0 exit-code))
|
|
|
8178 (progn
|
|
|
8179 (efs-set-host-property host 'chmod-failed t)
|
|
|
8180 (message "CHMOD %s failed for %s on %s." omode r-file host)
|
|
|
8181 (if efs-ding-on-chmod-failure
|
|
|
8182 (progn (ding) (sit-for 1))))))
|
|
22
|
8183 (let ((ent (efs-get-file-entry file)))
|
|
|
8184 (if ent
|
|
|
8185 (let* ((type
|
|
|
8186 (cond
|
|
|
8187 ((null (car ent)) "-")
|
|
|
8188 ((eq (car ent) t) "d")
|
|
|
8189 ((stringp (car ent)) "s")
|
|
|
8190 (t
|
|
|
8191 (error
|
|
|
8192 "Weird error in efs-set-file-modes"))))
|
|
|
8193 (mode-string (concat
|
|
|
8194 type
|
|
|
8195 (efs-mode-string
|
|
|
8196 (string-to-int omode))))
|
|
|
8197 (tail (nthcdr 3 ent)))
|
|
|
8198 (if (consp tail)
|
|
|
8199 (setcar tail mode-string)
|
|
|
8200 (efs-add-file-entry nil file (car ent) (nth 1 ent)
|
|
|
8201 (nth 2 ent) mode-string)))))))
|
|
|
8202 0)))) ; It should be safe to do this NOWAIT = 0
|
|
|
8203 ;; set-file-modes returns nil
|
|
|
8204 nil)
|
|
|
8205
|
|
|
8206 (defmacro efs-parse-mode-element (modes)
|
|
|
8207 ;; Parses MODES, a string of three chars, and returns an integer
|
|
|
8208 ;; between 0 and 7 according to how unix file modes are represented
|
|
|
8209 ;; for chmod.
|
|
|
8210 (` (if (= (length (, modes)) 3)
|
|
|
8211 (let ((list (mapcar
|
|
|
8212 (function (lambda (char)
|
|
|
8213 (if (memq char '( ?- ?S ?T)) 0 1)))
|
|
|
8214 (, modes))))
|
|
|
8215 ;; Convert to octal
|
|
|
8216 (+ (* (car list) 4) (* (nth 1 list) 2) (nth 2 list)))
|
|
|
8217 (error "Can't parse modes %s" (, modes)))))
|
|
|
8218
|
|
|
8219 (defun efs-parse-mode-string (string)
|
|
|
8220 ;; Parse a 9-character mode string, and return what it represents
|
|
|
8221 ;; as a decimal integer.
|
|
|
8222 (let ((owner (efs-parse-mode-element (substring string 0 3)))
|
|
|
8223 (group (efs-parse-mode-element (substring string 3 6)))
|
|
|
8224 (other (efs-parse-mode-element (substring string 6 9)))
|
|
|
8225 (owner-x (elt string 2))
|
|
|
8226 (group-x (elt string 5))
|
|
|
8227 (other-x (elt string 8)))
|
|
|
8228 (+ (* (+ (if (memq owner-x '(?s ?S)) 4 0)
|
|
|
8229 (if (memq group-x '(?s ?S)) 2 0)
|
|
|
8230 (if (memq other-x '(?t ?T)) 1 0))
|
|
|
8231 512)
|
|
|
8232 (* owner 64)
|
|
|
8233 (* group 8)
|
|
|
8234 other)))
|
|
|
8235
|
|
|
8236 (defun efs-file-modes (file)
|
|
|
8237 ;; Version of file-modes for remote files.
|
|
|
8238 ;; Returns nil if the file modes can't be determined, either because
|
|
|
8239 ;; the file doesn't exist, or for any other reason.
|
|
|
8240 (let* ((file (expand-file-name file))
|
|
|
8241 (parsed (efs-ftp-path file)))
|
|
|
8242 (and (memq (efs-host-type (car parsed)) efs-unix-host-types)
|
|
|
8243 ;; Someday we should cache mode strings for non-unix, but they
|
|
|
8244 ;; won't be in unix format. Also, CHMOD doesn't work for non-unix
|
|
|
8245 ;; hosts, so returning this info to emacs is a waste.
|
|
|
8246 (let* ((ent (efs-get-file-entry file))
|
|
|
8247 (modes (nth 3 ent)))
|
|
|
8248 (and modes
|
|
|
8249 (efs-parse-mode-string (substring modes 1)))))))
|
|
|
8250
|
|
|
8251 ;;;; ------------------------------------------------------------
|
|
|
8252 ;;;; Redefinition of Emacs file modtime support.
|
|
|
8253 ;;;; ------------------------------------------------------------
|
|
|
8254
|
|
|
8255 (defun efs-day-number (year month day)
|
|
|
8256 ;; Returns the day number within year of date. Taken from calendar.el,
|
|
|
8257 ;; by Edward Reingold. Thanks.
|
|
|
8258 ;; An explanation of the calculation can be found in PascAlgorithms by
|
|
|
8259 ;; Edward and Ruth Reingold, Scott-Foresman/Little, Brown, 1988.
|
|
|
8260 (let ((day-of-year (+ day (* 31 (1- month)))))
|
|
|
8261 (if (> month 2)
|
|
|
8262 (progn
|
|
|
8263 (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
|
|
|
8264 (if (zerop (% year 4))
|
|
|
8265 (setq day-of-year (1+ day-of-year)))))
|
|
|
8266 day-of-year))
|
|
|
8267
|
|
|
8268 (defun efs-days-elapsed (year month day)
|
|
|
8269 ;; Number of days elapsed since Jan 1, `efs-time-zero'
|
|
|
8270 (+ (efs-day-number year month day) ; days this year
|
|
|
8271 (* 365 (- year efs-time-zero)) ; days in prior years
|
|
|
8272 (- (/ (max (1- year) efs-time-zero) 4)
|
|
|
8273 (/ efs-time-zero 4)) ; leap years
|
|
|
8274 -1 )) ; don't count today
|
|
|
8275
|
|
|
8276 ;; 2^16 = 65536
|
|
|
8277 ;; Use this to avoid overflows
|
|
|
8278
|
|
|
8279 (defun efs-seconds-elapsed (year month day hours minutes seconds)
|
|
|
8280 ;; Computes the seconds elapsed from `efs-time-zero', in emacs'
|
|
|
8281 ;; format of a list of two integers, the first the higher 16-bits,
|
|
|
8282 ;; the second the lower 16-bits.
|
|
|
8283 (let* ((days (efs-days-elapsed year month day))
|
|
|
8284 ;; compute hours
|
|
|
8285 (hours (+ (* 24 days) hours))
|
|
|
8286 (high (lsh hours -16))
|
|
|
8287 (low (- hours (lsh high 16)))
|
|
|
8288 ;; compute minutes
|
|
|
8289 (low (+ (* low 60) minutes))
|
|
|
8290 (carry (lsh low -16))
|
|
|
8291 (high (+ (* high 60) carry))
|
|
|
8292 (low (- low (lsh carry 16)))
|
|
|
8293 ;; compute seconds
|
|
|
8294 (low (+ (* low 60) seconds))
|
|
|
8295 (carry (lsh low -16))
|
|
|
8296 (high (+ (* high 60) carry))
|
|
|
8297 (low (- low (lsh carry 16))))
|
|
|
8298 (list high low)))
|
|
|
8299
|
|
|
8300 (defun efs-parse-mdtime (string)
|
|
|
8301 ;; Parse a string, which is assumed to be the result of an ftp MDTM command.
|
|
|
8302 (efs-save-match-data
|
|
|
8303 (if (string-match efs-mdtm-msgs string)
|
|
|
8304 (efs-seconds-elapsed
|
|
|
8305 (string-to-int (substring string 4 8))
|
|
|
8306 (string-to-int (substring string 8 10))
|
|
|
8307 (string-to-int (substring string 10 12))
|
|
|
8308 (string-to-int (substring string 12 14))
|
|
|
8309 (string-to-int (substring string 14 16))
|
|
|
8310 (string-to-int (substring string 16 18))))))
|
|
|
8311
|
|
|
8312 (defun efs-parse-ctime (string)
|
|
|
8313 ;; Parse STRING which is assumed to be the result of a query over port 37.
|
|
|
8314 ;; Returns the number of seconds since the turn of the century, as a
|
|
|
8315 ;; list of two 16-bit integers.
|
|
|
8316 (and (= (length string) 4)
|
|
|
8317 (list (+ (lsh (aref string 0) 8) (aref string 1))
|
|
|
8318 (+ (lsh (aref string 2) 8) (aref string 3)))))
|
|
|
8319
|
|
|
8320 (defun efs-time-minus (time1 time2)
|
|
|
8321 ;; Subtract 32-bit integers, represented as two 16-bit integers.
|
|
|
8322 (let ((high (- (car time1) (car time2)))
|
|
|
8323 (low (- (nth 1 time1) (nth 1 time2))))
|
|
|
8324 (cond
|
|
|
8325 ((and (< high 0) (> low 0))
|
|
|
8326 (setq high (1+ high)
|
|
|
8327 low (- low 65536)))
|
|
|
8328 ((and (> high 0) (< low 0))
|
|
|
8329 (setq high (1- high)
|
|
|
8330 low (+ 65536 low))))
|
|
|
8331 (list high low)))
|
|
|
8332
|
|
|
8333 (defun efs-time-greater (time1 time2)
|
|
|
8334 ;; Compare two 32-bit integers, each represented as a list of two 16-bit
|
|
|
8335 ;; integers.
|
|
|
8336 (or (> (car time1) (car time2))
|
|
|
8337 (and (= (car time1) (car time2))
|
|
|
8338 (> (nth 1 time1) (nth 1 time2)))))
|
|
|
8339
|
|
|
8340 (defun efs-century-time (host &optional nowait cont)
|
|
|
8341 ;; Treat nil as the local host.
|
|
|
8342 ;; Returns the # of seconds since the turn of the century, according
|
|
|
8343 ;; to the system clock on host.
|
|
|
8344 ;; CONT is called with first arg HOST and second the # of seconds.
|
|
|
8345 (or host (setq host (system-name)))
|
|
|
8346 (efs-set-host-property host 'last-ctime nil)
|
|
|
8347 (efs-set-host-property host 'ctime-cont cont)
|
|
|
8348 (let ((name (format efs-ctime-process-name-format host))
|
|
|
8349 proc)
|
|
|
8350 (condition-case nil (delete-process name) (error nil))
|
|
|
8351 (if (and
|
|
|
8352 (or (efs-save-match-data (string-match efs-local-host-regexp host))
|
|
|
8353 (string-equal host (system-name)))
|
|
|
8354 (setq proc (condition-case nil
|
|
|
8355 (open-network-stream name nil host 37)
|
|
|
8356 (error nil))))
|
|
|
8357 (progn
|
|
|
8358 (set (intern name) "")
|
|
|
8359 (set-process-filter
|
|
|
8360 proc
|
|
|
8361 (function
|
|
|
8362 (lambda (proc string)
|
|
|
8363 (let ((name (process-name proc))
|
|
|
8364 result)
|
|
|
8365 (set (intern name) (concat (symbol-value (intern name))
|
|
|
8366 string))
|
|
|
8367 (setq result (efs-parse-ctime
|
|
|
8368 (symbol-value (intern name))))
|
|
|
8369 (if result
|
|
|
8370 (let* ((host (substring name 11 -1))
|
|
|
8371 (cont (efs-get-host-property host 'ctime-cont)))
|
|
|
8372 (efs-set-host-property host 'last-ctime result)
|
|
|
8373 (condition-case nil (delete-process proc) (error nil))
|
|
|
8374 (if cont
|
|
|
8375 (progn
|
|
|
8376 (efs-set-host-property host 'ctime-cont nil)
|
|
|
8377 (efs-call-cont cont host result)))))))))
|
|
|
8378 (set-process-sentinel
|
|
|
8379 proc
|
|
|
8380 (function
|
|
|
8381 (lambda (proc state)
|
|
|
8382 (let* ((name (process-name proc))
|
|
|
8383 (host (substring name 11 -1))
|
|
|
8384 (cont (efs-get-host-property host 'ctime-cont)))
|
|
|
8385 (makunbound (intern name))
|
|
|
8386 (or (efs-get-host-property host 'last-ctime)
|
|
|
8387 (if cont
|
|
|
8388 (progn
|
|
|
8389 (efs-set-host-property host 'ctime-cont nil)
|
|
|
8390 (efs-call-cont cont host 'failed))))))))
|
|
|
8391 (if nowait
|
|
|
8392 nil
|
|
|
8393 (let ((quit-flag nil)
|
|
|
8394 (inhibit-quit nil))
|
|
|
8395 (while (memq (process-status proc) '(run open))
|
|
|
8396 (accept-process-output)))
|
|
|
8397 (accept-process-output)
|
|
|
8398 (or (efs-get-host-property host 'last-ctime)
|
|
|
8399 'failed)))
|
|
|
8400 (if cont
|
|
|
8401 (progn
|
|
|
8402 (efs-set-host-property host 'ctime-cont nil)
|
|
|
8403 (efs-call-cont cont host 'failed)))
|
|
|
8404 (if nowait nil 'failed))))
|
|
|
8405
|
|
|
8406 (defun efs-clock-difference (host &optional nowait)
|
|
|
8407 ;; clock difference with the local host
|
|
|
8408 (let ((result (efs-get-host-property host 'clock-diff)))
|
|
|
8409 (or
|
|
|
8410 result
|
|
|
8411 (progn
|
|
|
8412 (efs-century-time
|
|
|
8413 host nowait
|
|
|
8414 (efs-cont (host result) (nowait)
|
|
|
8415 (if (eq result 'failed)
|
|
|
8416 (efs-set-host-property host 'clock-diff 'failed)
|
|
|
8417 (efs-century-time
|
|
|
8418 nil nowait
|
|
|
8419 (efs-cont (lhost lresult) (host result)
|
|
|
8420 (if (eq lresult 'failed)
|
|
|
8421 (efs-set-host-property host 'clock-diff 'failed)
|
|
|
8422 (efs-set-host-property host 'clock-diff
|
|
|
8423 (efs-time-minus result lresult))))))))
|
|
|
8424 (and (null nowait)
|
|
|
8425 (or (efs-get-host-property host 'clock-diff)
|
|
|
8426 'failed))))))
|
|
|
8427
|
|
|
8428 (defun efs-get-file-mdtm (host user file path)
|
|
|
8429 "For HOST and USER, return FILE's last modification time.
|
|
|
8430 PATH is the file name in full efs syntax.
|
|
|
8431 Returns a list of two six-digit integers which represent the 16 high order
|
|
|
8432 bits, and 16 low order bits of the number of elapsed seconds since
|
|
|
8433 `efs-time-zero'"
|
|
|
8434 (and (null (efs-get-host-property host 'mdtm-failed))
|
|
|
8435 (let ((result (efs-send-cmd host user (list 'quote 'mdtm file)
|
|
|
8436 (and (eq efs-verbose t)
|
|
|
8437 "Getting modtime")))
|
|
|
8438 parsed)
|
|
|
8439 (if (and (null (car result))
|
|
|
8440 (setq parsed (efs-parse-mdtime (nth 1 result))))
|
|
|
8441 (let ((ent (efs-get-file-entry path)))
|
|
|
8442 (if ent
|
|
|
8443 (setcdr ent (list (nth 1 ent) (nth 2 ent)
|
|
|
8444 (nth 3 ent) (nth 4 ent)
|
|
|
8445 parsed)))
|
|
|
8446 parsed)
|
|
|
8447 (efs-save-match-data
|
|
|
8448 ;; The 550 error is for a nonexistent file. Actually implies
|
|
|
8449 ;; that MDTM works.
|
|
|
8450 (if (string-match "^550 " (nth 1 result))
|
|
|
8451 '(0 0)
|
|
|
8452 (efs-set-host-property host 'mdtm-failed t)
|
|
|
8453 nil))))))
|
|
|
8454
|
|
|
8455 (efs-define-fun efs-set-emacs-bvf-mdtm (buffer mdtm)
|
|
|
8456 ;; Sets cached value for the buffer visited file modtime.
|
|
|
8457 (if (get-buffer buffer)
|
|
|
8458 (save-excursion
|
|
|
8459 (set-buffer buffer)
|
|
|
8460 (let (file-name-handler-alist)
|
|
|
8461 (set-visited-file-modtime mdtm)))))
|
|
|
8462
|
|
|
8463 ;; (defun efs-set-visited-file-modtime (&optional time)
|
|
|
8464 ;; ;; For remote files sets the modtime for a buffer to be that of the
|
|
|
8465 ;; ;; visited file. With arg TIME sets the modtime to TIME. TIME must be a list
|
|
|
8466 ;; ;; of two 16-bit integers.
|
|
|
8467 ;; ;; The function set-visited-file-modtime is for emacs-19. It doesn't
|
|
|
8468 ;; ;; exist in emacs 18. If you're running efs, it will work in emacs 18 for
|
|
|
8469 ;; ;; remote files only.
|
|
|
8470 ;; (if time
|
|
|
8471 ;; (efs-set-emacs-bvf-mdtm (current-buffer) time)
|
|
|
8472 ;; (let* ((path buffer-file-name)
|
|
|
8473 ;; (parsed (efs-ftp-path path))
|
|
|
8474 ;; (host (car parsed))
|
|
|
8475 ;; (user (nth 1 parsed))
|
|
|
8476 ;; (file (nth 2 parsed))
|
|
|
8477 ;; (buffer (current-buffer)))
|
|
|
8478 ;; (if (efs-save-match-data
|
|
|
8479 ;; (and efs-verify-modtime-host-regexp
|
|
|
8480 ;; (string-match efs-verify-modtime-host-regexp host)
|
|
|
8481 ;; (or efs-verify-anonymous-modtime
|
|
|
8482 ;; (not (efs-anonymous-p user)))
|
|
|
8483 ;; (not (efs-get-host-property host 'mdtm-failed))))
|
|
|
8484 ;; (efs-send-cmd
|
|
|
8485 ;; host user (list 'quote 'mdtm file)
|
|
|
8486 ;; nil nil
|
|
|
8487 ;; (efs-cont (result line cont-lines) (host user path buffer)
|
|
|
8488 ;; (let (modtime)
|
|
|
8489 ;; (if (and (null result)
|
|
|
8490 ;; (setq modtime (efs-parse-mdtime line)))
|
|
|
8491 ;; (let ((ent (efs-get-file-entry path)))
|
|
|
8492 ;; (if ent
|
|
|
8493 ;; (setcdr ent (list (nth 1 ent) (nth 2 ent)
|
|
|
8494 ;; (nth 3 ent) (nth 4 ent)
|
|
|
8495 ;; modtime)))
|
|
|
8496 ;; (setq buffer (and (setq buffer (get-buffer buffer))
|
|
|
8497 ;; (buffer-name buffer)))
|
|
|
8498 ;; ;; Beware that since this is happening asynch, the buffer
|
|
|
8499 ;; ;; may have disappeared.
|
|
|
8500 ;; (and buffer (efs-set-emacs-bvf-mdtm buffer modtime)))
|
|
|
8501 ;; (efs-save-match-data
|
|
|
8502 ;; (or (string-match "^550 " line)
|
|
|
8503 ;; (efs-set-host-property host 'mdtm-failed t)))
|
|
|
8504 ;; (efs-set-emacs-bvf-mdtm buffer 0)))) ; store dummy values
|
|
|
8505 ;; 0) ; Always do this NOWAIT = 0
|
|
|
8506 ;; (efs-set-emacs-bvf-mdtm buffer 0))
|
|
|
8507 ;; nil) ; return NIL
|
|
|
8508 ;; ))
|
|
|
8509
|
|
|
8510 (defvar efs-set-modtimes-synchronously nil
|
|
|
8511 "*Whether efs uses a synchronous FTP command to set the visited file modtime.
|
|
|
8512 Setting this variable to non-nil means that efs will set visited file modtimes
|
|
|
8513 synchronously.
|
|
|
8514
|
|
|
8515 Asynchronous setting of visited file modtimes leaves a very small
|
|
|
8516 window where Emacs may fail to detect a super session. However, it gives
|
|
|
8517 faster user access to newly visited files.")
|
|
|
8518
|
|
|
8519
|
|
|
8520 (defun efs-set-visited-file-modtime (&optional time)
|
|
|
8521 ;; For remote files sets the modtime for a buffer to be that of the
|
|
|
8522 ;; visited file. With arg TIME sets the modtime to TIME. TIME must be a list
|
|
|
8523 ;; of two 16-bit integers.
|
|
|
8524 ;; The function set-visited-file-modtime is for emacs-19. It doesn't
|
|
|
8525 ;; exist in emacs 18. If you're running efs, it will work in emacs 18 for
|
|
|
8526 ;; remote files only.
|
|
|
8527 (if time
|
|
|
8528 (efs-set-emacs-bvf-mdtm (current-buffer) time)
|
|
|
8529 (let* ((path buffer-file-name)
|
|
|
8530 (parsed (efs-ftp-path path))
|
|
|
8531 (host (car parsed))
|
|
|
8532 (user (nth 1 parsed))
|
|
|
8533 (file (nth 2 parsed))
|
|
|
8534 (buffer (current-buffer)))
|
|
|
8535 (if (efs-save-match-data
|
|
|
8536 (and efs-verify-modtime-host-regexp
|
|
|
8537 (string-match efs-verify-modtime-host-regexp host)
|
|
|
8538 (or efs-verify-anonymous-modtime
|
|
|
8539 (not (efs-anonymous-p user)))
|
|
|
8540 (not (efs-get-host-property host 'mdtm-failed))))
|
|
|
8541 (progn
|
|
|
8542 (or efs-set-modtimes-synchronously (clear-visited-file-modtime))
|
|
|
8543 (efs-send-cmd
|
|
|
8544 host user (list 'quote 'mdtm file)
|
|
|
8545 nil nil
|
|
|
8546 (efs-cont (result line cont-lines) (host user path buffer)
|
|
|
8547 (let (modtime)
|
|
|
8548 (if (and (null result)
|
|
|
8549 (setq modtime (efs-parse-mdtime line)))
|
|
|
8550 (let ((ent (efs-get-file-entry path)))
|
|
|
8551 (if ent
|
|
|
8552 (setcdr ent (list (nth 1 ent) (nth 2 ent)
|
|
|
8553 (nth 3 ent) (nth 4 ent)
|
|
|
8554 modtime)))
|
|
|
8555 (setq buffer (and (setq buffer (get-buffer buffer))
|
|
|
8556 (buffer-name buffer)))
|
|
|
8557 ;; Beware that since might be happening asynch,
|
|
|
8558 ;; the buffer may have disappeared.
|
|
|
8559 (and buffer (efs-set-emacs-bvf-mdtm buffer modtime)))
|
|
|
8560 (efs-save-match-data
|
|
|
8561 (or (string-match "^550 " line)
|
|
|
8562 (efs-set-host-property host 'mdtm-failed t)))
|
|
|
8563 (efs-set-emacs-bvf-mdtm buffer '(0 0))))) ; store dummy values
|
|
|
8564 (and (null efs-set-modtimes-synchronously) 0)))
|
|
|
8565 (efs-set-emacs-bvf-mdtm buffer '(0 0)))
|
|
|
8566 nil))) ; return NIL
|
|
|
8567
|
|
|
8568 (defun efs-file-newer-than-file-p (file1 file2)
|
|
|
8569 ;; Version of file-newer-than-file-p for remote files.
|
|
|
8570 (let* ((file1 (expand-file-name file1))
|
|
|
8571 (file2 (expand-file-name file2))
|
|
|
8572 (parsed1 (efs-ftp-path file1))
|
|
|
8573 (parsed2 (efs-ftp-path file2))
|
|
|
8574 (host1 (car parsed1))
|
|
|
8575 (host2 (car parsed2))
|
|
|
8576 (user1 (nth 1 parsed1))
|
|
|
8577 (user2 (nth 1 parsed2)))
|
|
|
8578 (cond
|
|
|
8579 ;; If the first file doedn't exist, or is remote but
|
|
|
8580 ;; we're not supposed to check modtimes on it, return nil.
|
|
|
8581 ((or (null (file-exists-p file1))
|
|
|
8582 (and parsed1
|
|
|
8583 (or
|
|
|
8584 (null efs-verify-modtime-host-regexp)
|
|
|
8585 (efs-get-host-property host1 'mdtm-failed)
|
|
|
8586 (not (string-match efs-verify-modtime-host-regexp host1))
|
|
|
8587 (and (null efs-verify-anonymous-modtime)
|
|
|
8588 (efs-anonymous-p user1)))))
|
|
|
8589 nil)
|
|
|
8590 ;; If the same is true for the second file, return t.
|
|
|
8591 ((or (null (file-exists-p file2))
|
|
|
8592 (and parsed2
|
|
|
8593 (or
|
|
|
8594 (null efs-verify-modtime-host-regexp)
|
|
|
8595 (efs-get-host-property host2 'mdtm-failed)
|
|
|
8596 (not (string-match efs-verify-modtime-host-regexp host2))
|
|
|
8597 (and (null efs-verify-anonymous-modtime)
|
|
|
8598 (efs-anonymous-p user2)))))
|
|
|
8599 t)
|
|
|
8600 ;; Calculate modtimes. If we get here, any remote files should
|
|
|
8601 ;; have a file entry.
|
|
|
8602 (t
|
|
|
8603 (let (mod1 mod2 shift1 shift2)
|
|
|
8604 (if parsed1
|
|
|
8605 (let ((ent (efs-get-file-entry file1)))
|
|
|
8606 (setq mod1 (nth 5 ent)
|
|
|
8607 shift1 (efs-clock-difference host1))
|
|
|
8608 (or mod1
|
|
|
8609 (setq mod1 (efs-get-file-mdtm
|
|
|
8610 host1 user1 (nth 2 parsed1) file1))))
|
|
|
8611 (setq mod1 (nth 5 (file-attributes file1))))
|
|
|
8612 (if parsed2
|
|
|
8613 (let ((ent (efs-get-file-entry file2)))
|
|
|
8614 (setq mod2 (nth 5 ent)
|
|
|
8615 shift2 (efs-clock-difference host2))
|
|
|
8616 (or mod2
|
|
|
8617 (setq mod2 (efs-get-file-mdtm
|
|
|
8618 host2 user2 (nth 2 parsed2) file2))))
|
|
|
8619 (setq mod2 (nth 5 (file-attributes file2))))
|
|
|
8620 ;; If we can't compute clock shifts, we act as if we don't
|
|
|
8621 ;; even know the modtime. Should we have more faith in ntp?
|
|
|
8622 (cond
|
|
|
8623 ((or (null mod1) (eq shift1 'failed))
|
|
|
8624 nil)
|
|
|
8625 ((or (null mod2) (eq shift2 'failed))
|
|
|
8626 t)
|
|
|
8627 ;; We get to compute something!
|
|
|
8628 (t
|
|
|
8629 (efs-time-greater
|
|
|
8630 (if shift1 (efs-time-minus mod1 shift1) mod1)
|
|
|
8631 (if shift2 (efs-time-minus mod2 shift2) mod2)))))))))
|
|
|
8632
|
|
|
8633 (defun efs-verify-visited-file-modtime (buff)
|
|
|
8634 ;; Verifies the modtime for buffers visiting remote files.
|
|
|
8635 ;; Won't get called for buffer not visiting any file.
|
|
|
8636 (let ((buff (get-buffer buff)))
|
|
|
8637 (null
|
|
|
8638 (and buff ; return t if no buffer? Need to beware of multi-threading.
|
|
|
8639 (buffer-file-name buff) ; t if no file
|
|
|
8640 (let ((mdtm (save-excursion
|
|
|
8641 (set-buffer buff)
|
|
|
8642 (visited-file-modtime))))
|
|
|
8643 (and
|
|
|
8644 (not (eq mdtm 0))
|
|
|
8645 (not (equal mdtm '(0 0)))
|
|
|
8646 efs-verify-modtime-host-regexp
|
|
|
8647 (let* ((path (buffer-file-name buff))
|
|
|
8648 (parsed (efs-ftp-path path))
|
|
|
8649 (host (car parsed))
|
|
|
8650 (user (nth 1 parsed))
|
|
|
8651 nmdtm)
|
|
|
8652 (and
|
|
|
8653 (null (efs-get-host-property host 'mdtm-failed))
|
|
|
8654 (efs-save-match-data
|
|
|
8655 (string-match
|
|
|
8656 efs-verify-modtime-host-regexp host))
|
|
|
8657 (or efs-verify-anonymous-modtime
|
|
|
8658 (not (efs-anonymous-p user)))
|
|
|
8659 (setq nmdtm (efs-get-file-mdtm host user (nth 2 parsed) path))
|
|
|
8660 (progn
|
|
|
8661 (or (equal nmdtm '(0 0))
|
|
|
8662 (file-exists-p path) ; Make sure that there is an entry.
|
|
|
8663 (null
|
|
|
8664 (efs-get-files
|
|
|
8665 (file-name-directory
|
|
|
8666 (efs-internal-directory-file-name path))))
|
|
|
8667 (efs-add-file-entry
|
|
|
8668 (efs-host-type host) path nil nil nil nil nil nmdtm))
|
|
|
8669 (null (and (eq (cdr mdtm) (nth 1 nmdtm))
|
|
|
8670 (eq (car mdtm) (car nmdtm)))))))))))))
|
|
|
8671
|
|
|
8672 ;;;; -----------------------------------------------------------
|
|
|
8673 ;;;; Redefinition of Emacs file name completion
|
|
|
8674 ;;;; -----------------------------------------------------------
|
|
|
8675
|
|
|
8676 (defmacro efs-set-completion-ignored-pattern ()
|
|
|
8677 ;; Set regexp efs-completion-ignored-pattern
|
|
|
8678 ;; to use for filename completion.
|
|
|
8679 (`
|
|
|
8680 (or (equal efs-completion-ignored-extensions
|
|
|
8681 completion-ignored-extensions)
|
|
|
8682 (setq efs-completion-ignored-extensions
|
|
|
8683 completion-ignored-extensions
|
|
|
8684 efs-completion-ignored-pattern
|
|
|
8685 (mapconcat (function
|
|
|
8686 (lambda (s) (if (stringp s)
|
|
|
8687 (concat (regexp-quote s) "$")
|
|
|
8688 "/"))) ; / never in filename
|
|
|
8689 efs-completion-ignored-extensions
|
|
|
8690 "\\|")))))
|
|
|
8691
|
|
|
8692 (defun efs-file-entry-active-p (sym)
|
|
|
8693 ;; If the file entry is a symlink, returns whether the file pointed to
|
|
|
8694 ;; exists.
|
|
|
8695 ;; Note that DIR is dynamically bound.
|
|
|
8696 (let ((file-type (car (get sym 'val))))
|
|
|
8697 (or (not (stringp file-type))
|
|
|
8698 (file-exists-p (efs-chase-symlinks
|
|
|
8699 (expand-file-name file-type efs-completion-dir))))))
|
|
|
8700
|
|
|
8701 (defun efs-file-entry-not-ignored-p (sym)
|
|
|
8702 ;; If the file entry is not a directory (nor a symlink pointing to a
|
|
|
8703 ;; directory) returns whether the file (or file pointed to by the symlink)
|
|
|
8704 ;; is ignored by completion-ignored-extensions.
|
|
|
8705 (let ((file-type (car (get sym 'val)))
|
|
|
8706 (symname (symbol-name sym)))
|
|
|
8707 (if (stringp file-type)
|
|
|
8708 ;; Maybe file-truename would be better here, but it is very costly
|
|
|
8709 ;; to chase symlinks at every level over FTP.
|
|
|
8710 (let ((file (efs-chase-symlinks (expand-file-name
|
|
|
8711 file-type efs-completion-dir))))
|
|
|
8712 (or (file-directory-p file)
|
|
|
8713 (and (file-exists-p file)
|
|
|
8714 (not (string-match efs-completion-ignored-pattern
|
|
|
8715 symname)))))
|
|
|
8716 (or file-type ; is a directory name
|
|
|
8717 (not (string-match efs-completion-ignored-pattern symname))))))
|
|
|
8718
|
|
|
8719 (defun efs-file-name-all-completions (file dir)
|
|
|
8720 ;; Does file-name-all-completions in remote directories.
|
|
|
8721 (efs-barf-if-not-directory dir)
|
|
|
8722 (let* ((efs-completion-dir (file-name-as-directory (expand-file-name dir)))
|
|
|
8723 (completion-ignore-case
|
|
|
8724 (memq (efs-host-type (car (efs-ftp-path efs-completion-dir)))
|
|
|
8725 efs-case-insensitive-host-types))
|
|
|
8726 (tbl (efs-get-files efs-completion-dir))
|
|
|
8727 (completions
|
|
|
8728 (all-completions file tbl
|
|
|
8729 (function efs-file-entry-active-p))))
|
|
|
8730 ;; see whether each matching file is a directory or not...
|
|
|
8731 (mapcar
|
|
|
8732 ;; Since the entries in completions will match the case
|
|
|
8733 ;; of the entries in tbl, don't need to case-fold
|
|
|
8734 ;; in efs-get-hash-entry below.
|
|
|
8735 (function
|
|
|
8736 (lambda (file)
|
|
|
8737 (let ((ent (car (efs-get-hash-entry file tbl))))
|
|
|
8738 (if (or (eq ent t)
|
|
|
8739 (and (stringp ent)
|
|
|
8740 (file-directory-p (efs-chase-symlinks
|
|
|
8741 (expand-file-name
|
|
|
8742 ent efs-completion-dir)))))
|
|
|
8743 (concat file "/")
|
|
|
8744 file))))
|
|
|
8745 completions)))
|
|
|
8746
|
|
|
8747 (defun efs-file-name-completion (file dir)
|
|
|
8748 ;; Does file name expansion in remote directories.
|
|
|
8749 (efs-barf-if-not-directory dir)
|
|
|
8750 (if (equal file "")
|
|
|
8751 ""
|
|
|
8752 (let* ((efs-completion-dir (file-name-as-directory (expand-file-name dir)))
|
|
|
8753 (completion-ignore-case
|
|
|
8754 (memq (efs-host-type (car (efs-ftp-path efs-completion-dir)))
|
|
|
8755 efs-case-insensitive-host-types))
|
|
|
8756 (tbl (efs-get-files efs-completion-dir)))
|
|
|
8757 (efs-set-completion-ignored-pattern)
|
|
|
8758 (efs-save-match-data
|
|
|
8759 (or (efs-file-name-completion-1
|
|
|
8760 file tbl efs-completion-dir
|
|
|
8761 (function efs-file-entry-not-ignored-p))
|
|
|
8762 (efs-file-name-completion-1
|
|
|
8763 file tbl efs-completion-dir
|
|
|
8764 (function efs-file-entry-active-p)))))))
|
|
|
8765
|
|
|
8766 (defun efs-file-name-completion-1 (file tbl dir predicate)
|
|
|
8767 ;; Internal subroutine for efs-file-name-completion. Do not call this.
|
|
|
8768 (let ((bestmatch (try-completion file tbl predicate)))
|
|
|
8769 (if bestmatch
|
|
|
8770 (if (eq bestmatch t)
|
|
|
8771 (if (file-directory-p (expand-file-name file dir))
|
|
|
8772 (concat file "/")
|
|
|
8773 t)
|
|
|
8774 (if (and (eq (try-completion bestmatch tbl predicate) t)
|
|
|
8775 (file-directory-p
|
|
|
8776 (expand-file-name bestmatch dir)))
|
|
|
8777 (concat bestmatch "/")
|
|
|
8778 bestmatch)))))
|
|
|
8779
|
|
|
8780 ;;;; ----------------------------------------------------------
|
|
|
8781 ;;;; Functions for loading lisp.
|
|
|
8782 ;;;; ----------------------------------------------------------
|
|
|
8783
|
|
|
8784 ;;; jka-load provided ideas here. Thanks, Jay.
|
|
|
8785
|
|
|
8786 (defun efs-load-openp (str suffixes)
|
|
|
8787 ;; Given STR, searches load-path and efs-load-lisp-extensions
|
|
|
8788 ;; for the name of a file to load. Returns the full path, or nil
|
|
|
8789 ;; if none found.
|
|
|
8790 (let ((path-list (if (file-name-absolute-p str) t load-path))
|
|
|
8791 root result)
|
|
|
8792 ;; If there is no load-path, at least try the default directory.
|
|
|
8793 (or path-list
|
|
|
8794 (setq path-list (list default-directory)))
|
|
|
8795 (while (and path-list (null result))
|
|
|
8796 (if (eq path-list t)
|
|
|
8797 (setq path-list nil
|
|
|
8798 root str)
|
|
|
8799 (setq root (expand-file-name str (car path-list))
|
|
|
8800 path-list (cdr path-list))
|
|
|
8801 (or (file-name-absolute-p root)
|
|
|
8802 (setq root (expand-file-name root default-directory))))
|
|
|
8803 (let ((suff-list suffixes))
|
|
|
8804 (while (and suff-list (null result))
|
|
|
8805 (let ((try (concat root (car suff-list))))
|
|
|
8806 (if (or (not (file-readable-p try))
|
|
|
8807 (file-directory-p try))
|
|
|
8808 (setq suff-list (cdr suff-list))
|
|
|
8809 (setq result try))))))
|
|
|
8810 result))
|
|
|
8811
|
|
|
8812 (defun efs-load (file &optional noerror nomessage nosuffix)
|
|
|
8813 "Documented as original."
|
|
|
8814 (let ((filename (efs-load-openp
|
|
|
8815 file
|
|
|
8816 (if nosuffix '("") efs-load-lisp-extensions))))
|
|
|
8817 (if (not filename)
|
|
|
8818 (and (null noerror) (error "Cannot open load file %s" file))
|
|
|
8819 (let ((parsed (efs-ftp-path filename))
|
|
|
8820 (after-load (and (boundp 'after-load-alist)
|
|
|
8821 (assoc file after-load-alist))))
|
|
|
8822 (if parsed
|
|
|
8823 (let ((temp (car (efs-make-tmp-name nil (car parsed)))))
|
|
|
8824 (unwind-protect
|
|
|
8825 (progn
|
|
|
8826 (efs-copy-file-internal
|
|
|
8827 filename parsed temp nil t nil
|
|
|
8828 (format "Getting %s" filename))
|
|
|
8829 (or (file-readable-p temp)
|
|
|
8830 (error
|
|
|
8831 "efs-load: temp file %s is unreadable" temp))
|
|
|
8832 (or nomessage
|
|
|
8833 (message "Loading %s..." file))
|
|
|
8834 ;; temp is an absolute filename, so load path
|
|
|
8835 ;; won't be searched.
|
|
|
8836 (let (after-load-alist)
|
|
|
8837 (efs-real-load temp t t t))
|
|
|
8838 (or nomessage
|
|
|
8839 (message "Loading %s...done" file))
|
|
|
8840 (if after-load (mapcar 'eval (cdr after-load)))
|
|
|
8841 t) ; return t if everything worked
|
|
|
8842 (efs-del-tmp-name temp)))
|
|
|
8843 (prog2
|
|
|
8844 (or nomessage
|
|
|
8845 (message "Loading %s..." file))
|
|
|
8846 (let (after-load-alist)
|
|
|
8847 (or (efs-real-load filename noerror t t)
|
|
|
8848 (setq after-load nil)))
|
|
|
8849 (or nomessage
|
|
|
8850 (message "Loading %s...done" file))
|
|
|
8851 (if after-load (mapcar 'eval (cdr after-load)))))))))
|
|
|
8852
|
|
|
8853 (defun efs-require (feature &optional filename)
|
|
|
8854 "Documented as original."
|
|
|
8855 (if (eq feature 'ange-ftp) (efs-require-scream-and-yell))
|
|
|
8856 (if (featurep feature)
|
|
|
8857 feature
|
|
|
8858 (or filename (setq filename (symbol-name feature)))
|
|
|
8859 (let ((fullpath (efs-load-openp filename
|
|
|
8860 efs-load-lisp-extensions)))
|
|
|
8861 (if (not fullpath)
|
|
|
8862 (error "Cannot open load file: %s" filename)
|
|
|
8863 (let ((parsed (efs-ftp-path fullpath)))
|
|
|
8864 (if parsed
|
|
|
8865 (let ((temp (car (efs-make-tmp-name nil (car parsed)))))
|
|
|
8866 (unwind-protect
|
|
|
8867 (progn
|
|
|
8868 (efs-copy-file-internal
|
|
|
8869 fullpath parsed temp nil t nil
|
|
|
8870 (format "Getting %s" fullpath))
|
|
|
8871 (or (file-readable-p temp)
|
|
|
8872 (error
|
|
|
8873 "efs-require: temp file %s is unreadable" temp))
|
|
|
8874 (efs-real-require feature temp))
|
|
|
8875 (efs-del-tmp-name temp)))
|
|
|
8876 (efs-real-require feature fullpath)))))))
|
|
|
8877
|
|
|
8878 (defun efs-require-scream-and-yell ()
|
|
|
8879 ;; Complain if something attempts to load ange-ftp.
|
|
|
8880 (with-output-to-temp-buffer "*Help*"
|
|
|
8881 (princ
|
|
|
8882 "Something tried to load ange-ftp.
|
|
|
8883 EFS AND ANGE-FTP DO NOT WORK TOGETHER.
|
|
|
8884
|
|
|
8885 If the culprit package does need to access ange-ftp internal functions,
|
|
|
8886 then it should be adequate to simply remove the \(require 'ange-ftp\)
|
|
|
8887 line and let efs handle remote file access. Otherwise, it will need to
|
|
|
8888 be ported to efs. This may already have been done, and you can find out
|
|
|
8889 by sending an enquiry to efs-help@cuckoo.hpl.hp.com.
|
|
|
8890
|
|
|
8891 Signalling an error with backtrace will allow you to determine which
|
|
|
8892 package was requiring ange-ftp.\n"))
|
|
|
8893 (select-window (get-buffer-window "*Help*"))
|
|
|
8894 (enlarge-window (- (count-lines (point-min) (point-max))
|
|
|
8895 (window-height) -1))
|
|
|
8896 (if (y-or-n-p "Signal error with backtrace? ")
|
|
|
8897 (let ((stack-trace-on-error t))
|
|
|
8898 (error "Attempt to require ange-ftp"))))
|
|
|
8899
|
|
|
8900 ;;;; -----------------------------------------------------------
|
|
|
8901 ;;;; Redefinition of Emacs functions for reading file names.
|
|
|
8902 ;;;; -----------------------------------------------------------
|
|
|
8903
|
|
|
8904 (defun efs-unexpand-parsed-filename (host user path)
|
|
|
8905 ;; Replaces the home directory in path with "~". Returns the unexpanded
|
|
|
8906 ;; full-path.
|
|
|
8907 (let* ((path-len (length path))
|
|
|
8908 (def-user (efs-get-user host))
|
|
|
8909 (host-type (efs-host-type host user))
|
|
|
8910 (ignore-case (memq host-type efs-case-insensitive-host-types)))
|
|
|
8911 (if (> path-len 1)
|
|
|
8912 (let* ((home (efs-expand-tilde "~" host-type host user))
|
|
|
8913 (home-len (length home)))
|
|
|
8914 (if (and (> path-len home-len)
|
|
|
8915 (if ignore-case (string-equal (downcase home)
|
|
|
8916 (downcase
|
|
|
8917 (substring path
|
|
|
8918 0 home-len)))
|
|
|
8919 (string-equal home (substring path 0 home-len)))
|
|
|
8920 (= (aref path home-len) ?/))
|
|
|
8921 (setq path (concat "~" (substring path home-len))))))
|
|
|
8922 (if (if ignore-case (string-equal (downcase user)
|
|
|
8923 (downcase def-user))
|
|
|
8924 (string-equal user def-user))
|
|
|
8925 (format efs-path-format-without-user host path)
|
|
|
8926 (format efs-path-format-string user host path))))
|
|
|
8927
|
|
48
|
8928 (efs-define-fun efs-abbreviate-file-name (filename &optional ignored-for-now)
|
|
22
|
8929 ;; Version of abbreviate-file-name for remote files.
|
|
|
8930 (efs-save-match-data
|
|
|
8931 (let ((tail directory-abbrev-alist))
|
|
|
8932 (while tail
|
|
|
8933 (if (string-match (car (car tail)) filename)
|
|
|
8934 (setq filename
|
|
|
8935 (concat (cdr (car tail))
|
|
|
8936 (substring filename (match-end 0)))))
|
|
|
8937 (setq tail (cdr tail)))
|
|
|
8938 (apply 'efs-unexpand-parsed-filename (efs-ftp-path filename)))))
|
|
|
8939
|
|
|
8940 (defun efs-default-dir-function ()
|
|
|
8941 (let ((parsed (efs-ftp-path default-directory))
|
|
|
8942 (dd default-directory))
|
|
|
8943 (if parsed
|
|
|
8944 (efs-save-match-data
|
|
|
8945 (let ((tail directory-abbrev-alist))
|
|
|
8946 (while tail
|
|
|
8947 (if (string-match (car (car tail)) dd)
|
|
|
8948 (setq dd (concat (cdr (car tail))
|
|
|
8949 (substring dd (match-end 0)))
|
|
|
8950 parsed nil))
|
|
|
8951 (setq tail (cdr tail)))
|
|
|
8952 (apply 'efs-unexpand-parsed-filename
|
|
|
8953 (or parsed (efs-ftp-path dd)))))
|
|
|
8954 default-directory)))
|
|
|
8955
|
|
|
8956 (defun efs-re-read-dir (&optional dir)
|
|
|
8957 "Forces a re-read of the directory DIR.
|
|
|
8958 If DIR is omitted then it defaults to the directory part of the contents
|
|
|
8959 of the current buffer. This is so this function can be caled from the
|
|
|
8960 minibuffer."
|
|
|
8961 (interactive)
|
|
|
8962 (if dir
|
|
|
8963 (setq dir (expand-file-name dir))
|
|
|
8964 (setq dir (file-name-directory (expand-file-name (buffer-string)))))
|
|
|
8965 (let ((parsed (efs-ftp-path dir)))
|
|
|
8966 (if parsed
|
|
|
8967 (let ((efs-ls-uncache t))
|
|
|
8968 (efs-del-hash-entry (efs-canonize-file-name dir)
|
|
|
8969 efs-files-hashtable)
|
|
|
8970 (efs-get-files dir t)))))
|
|
|
8971
|
|
|
8972 ;;;; ---------------------------------------------------------------
|
|
|
8973 ;;;; Creation and deletion of files and directories.
|
|
|
8974 ;;;; ---------------------------------------------------------------
|
|
|
8975
|
|
|
8976 (defun efs-delete-file (file)
|
|
|
8977 ;; Deletes remote files.
|
|
|
8978 (let* ((file (expand-file-name file))
|
|
|
8979 (parsed (efs-ftp-path file))
|
|
|
8980 (host (car parsed))
|
|
|
8981 (user (nth 1 parsed))
|
|
|
8982 (host-type (efs-host-type host user))
|
|
|
8983 (path (nth 2 parsed))
|
|
|
8984 (abbr (efs-relativize-filename file))
|
|
|
8985 (result (efs-send-cmd host user (list 'delete path)
|
|
|
8986 (format "Deleting %s" abbr))))
|
|
|
8987 (if (car result)
|
|
|
8988 (signal 'ftp-error
|
|
|
8989 (list "Removing old name"
|
|
|
8990 (format "FTP Error: \"%s\"" (nth 1 result))
|
|
|
8991 file)))
|
|
|
8992 (efs-delete-file-entry host-type file)))
|
|
|
8993
|
|
|
8994 (defun efs-make-directory-internal (dir)
|
|
|
8995 ;; version of make-directory-internal for remote directories.
|
|
|
8996 (if (file-exists-p dir)
|
|
|
8997 (error "Cannot make directory %s: file already exists" dir)
|
|
|
8998 (let* ((parsed (efs-ftp-path dir))
|
|
|
8999 (host (nth 0 parsed))
|
|
|
9000 (user (nth 1 parsed))
|
|
|
9001 (host-type (efs-host-type host user))
|
|
|
9002 ;; Some ftp's on unix machines (at least on Suns)
|
|
|
9003 ;; insist that mkdir take a filename, and not a
|
|
|
9004 ;; directory-name name as an arg. Argh!! This is a bug.
|
|
|
9005 ;; Non-unix machines will probably always insist
|
|
|
9006 ;; that mkdir takes a directory-name as an arg
|
|
|
9007 ;; (as the ftp man page says it should).
|
|
|
9008 (path (if (or (memq host-type efs-unix-host-types)
|
|
|
9009 (memq host-type '(os2 dos)))
|
|
|
9010 (efs-internal-directory-file-name (nth 2 parsed))
|
|
|
9011 (efs-internal-file-name-as-directory
|
|
|
9012 host-type (nth 2 parsed))))
|
|
|
9013 (abbr (efs-relativize-filename dir))
|
|
|
9014 (result (efs-send-cmd host user
|
|
|
9015 (list 'mkdir path)
|
|
|
9016 (format "Making directory %s"
|
|
|
9017 abbr))))
|
|
|
9018 (if (car result)
|
|
|
9019 (efs-error host user
|
|
|
9020 (format "Could not make directory %s: %s" dir
|
|
|
9021 (nth 1 result))))
|
|
|
9022 (efs-add-file-entry host-type dir t nil user))))
|
|
|
9023
|
|
|
9024 ;; V19 calls this function delete-directory. It used to be called
|
|
|
9025 ;; remove-directory.
|
|
|
9026
|
|
|
9027 (defun efs-delete-directory (dir)
|
|
|
9028 ;; Version of delete-directory for remote directories.
|
|
|
9029 (if (file-directory-p dir)
|
|
|
9030 (let* ((parsed (efs-ftp-path dir))
|
|
|
9031 (host (nth 0 parsed))
|
|
|
9032 (user (nth 1 parsed))
|
|
|
9033 (host-type (efs-host-type host user))
|
|
|
9034 ;; Some ftp's on unix machines (at least on Suns)
|
|
|
9035 ;; insist that rmdir take a filename, and not a
|
|
|
9036 ;; directory-name name as an arg. Argh!! This is a bug.
|
|
|
9037 ;; Non-unix machines will probably always insist
|
|
|
9038 ;; that rmdir takes a directory-name as an arg
|
|
|
9039 ;; (as the ftp man page says it should).
|
|
|
9040 (path
|
|
|
9041 (if (or (memq host-type efs-unix-host-types)
|
|
|
9042 (memq host-type '(os2 dos)))
|
|
|
9043 (efs-internal-directory-file-name (nth 2 parsed))
|
|
|
9044 (efs-internal-file-name-as-directory
|
|
|
9045 host-type (nth 2 parsed))))
|
|
|
9046 (abbr (efs-relativize-filename dir))
|
|
|
9047 (result (efs-send-cmd host user
|
|
|
9048 (list 'rmdir path)
|
|
|
9049 (format "Deleting directory %s" abbr))))
|
|
|
9050 (if (car result)
|
|
|
9051 (efs-error host user
|
|
|
9052 (format "Could not delete directory %s: %s"
|
|
|
9053 dir (nth 1 result))))
|
|
|
9054 (efs-delete-file-entry host-type dir t))
|
|
|
9055 (error "Not a directory: %s" dir)))
|
|
|
9056
|
|
|
9057 (defun efs-file-local-copy (file)
|
|
|
9058 ;; internal function for diff.el (dired 6.3 or later)
|
|
|
9059 ;; Makes a temp file containing the contents of file.
|
|
|
9060 ;; returns the name of the tmp file created, or nil if none is.
|
|
|
9061 ;; This function should have optional cont and nowait args.
|
|
|
9062 (let* ((file (expand-file-name file))
|
|
|
9063 (tmp (car (efs-make-tmp-name nil (car (efs-ftp-path file))))))
|
|
|
9064 (efs-copy-file-internal file (efs-ftp-path file)
|
|
|
9065 tmp nil t nil (format "Getting %s" file))
|
|
|
9066 tmp))
|
|
|
9067
|
|
|
9068 (defun efs-diff/grep-del-temp-file (temp)
|
|
|
9069 ;; internal function for diff.el and grep.el
|
|
|
9070 ;; if TEMP is non-nil, deletes the temp file TEMP.
|
|
|
9071 ;; if TEMP is nil, does nothing.
|
|
|
9072 (and temp
|
|
|
9073 (efs-del-tmp-name temp)))
|
|
|
9074
|
|
|
9075 ;;;; ------------------------------------------------------------
|
|
|
9076 ;;;; File copying support...
|
|
|
9077 ;;;; ------------------------------------------------------------
|
|
|
9078
|
|
|
9079 ;;; - totally re-written 6/24/92.
|
|
|
9080 ;;; - re-written again 9/3/93
|
|
|
9081 ;;; - and again 14/4/93
|
|
|
9082 ;;; - and again 17/8/93
|
|
|
9083
|
|
|
9084 (defun efs-barf-or-query-if-file-exists (absname querystring interactive)
|
|
|
9085 (if (file-exists-p absname)
|
|
|
9086 (if (not interactive)
|
|
|
9087 (signal 'file-already-exists (list absname))
|
|
|
9088 (if (not (yes-or-no-p (format "File %s already exists; %s anyway? "
|
|
|
9089 absname querystring)))
|
|
|
9090 (signal 'file-already-exists (list absname))))))
|
|
|
9091
|
|
|
9092 (defun efs-concatenate-files (file1 file2)
|
|
|
9093 ;; Concatenates file1 to file2. Both must be local files.
|
|
|
9094 ;; Needed because the efs version of copy-file understands
|
|
|
9095 ;; ok-if-already-exists = 'append
|
|
|
9096 (or (file-readable-p file1)
|
|
|
9097 (signal 'file-error
|
|
|
9098 (list (format "Input file %s not readable." file1))))
|
|
|
9099 (or (file-writable-p file2)
|
|
|
9100 (signal 'file-error
|
|
|
9101 (list (format "Output file %s not writable." file2))))
|
|
|
9102 (let ((default-directory exec-directory))
|
|
|
9103 (call-process "sh" nil nil nil "-c" (format "cat %s >> %s" file1 file2))))
|
|
|
9104
|
|
|
9105 (defun efs-copy-add-file-entry (newname host-type user size append)
|
|
|
9106 ;; Add an entry in `efs-files-hashtable' for a file newly created via a copy.
|
|
|
9107 (if (eq size -1) (setq size nil))
|
|
|
9108 (if append
|
|
|
9109 (let ((ent (efs-get-file-entry newname)))
|
|
|
9110 (if (and ent (null (car ent)))
|
|
|
9111 (if (and size (numberp (nth 1 ent)))
|
|
|
9112 (setcar (cdr ent) (+ size (nth 1 ent)))
|
|
|
9113 (setcar (cdr ent) nil))
|
|
|
9114 ;; If the ent is a symlink or directory, don't overwrite that entry.
|
|
|
9115 (if (null ent)
|
|
|
9116 (efs-add-file-entry host-type newname nil nil nil))))
|
|
|
9117 (efs-add-file-entry host-type newname nil size user)))
|
|
|
9118
|
|
|
9119 (defun efs-copy-remote-to-remote (f-host-type f-host f-user f-path filename
|
|
|
9120 t-host-type t-host t-user
|
|
|
9121 t-path newname append msg cont
|
|
|
9122 nowait xfer-type)
|
|
|
9123 ;; Use a 3rd data connection to copy from F-HOST for F-USER to T-HOST
|
|
|
9124 ;; for T-USER.
|
|
|
9125 (if (efs-get-host-property t-host 'pasv-failed)
|
|
|
9126 ;; PASV didn't work before, don't try again.
|
|
|
9127 (if cont (efs-call-cont cont 'failed "" ""))
|
|
|
9128 (or xfer-type
|
|
|
9129 (setq xfer-type (efs-xfer-type f-host-type filename
|
|
|
9130 t-host-type newname)))
|
|
|
9131 (efs-send-cmd
|
|
|
9132 t-host t-user '(quote pasv) nil nil
|
|
|
9133 (efs-cont (pasv-result pasv-line pasv-cont-lines)
|
|
|
9134 (cont nowait f-host-type f-host f-user f-path filename
|
|
|
9135 t-host-type t-host t-user t-path newname xfer-type msg append)
|
|
|
9136 (efs-save-match-data
|
|
|
9137 (if (or pasv-result
|
|
|
9138 (not (string-match efs-pasv-msgs pasv-line)))
|
|
|
9139 (progn
|
|
|
9140 (efs-set-host-property t-host 'pasv-failed t)
|
|
|
9141 (if cont
|
|
|
9142 (efs-call-cont
|
|
|
9143 cont (or pasv-result 'failed) pasv-line pasv-cont-lines)))
|
|
|
9144 (let ((address (substring pasv-line (match-beginning 1)
|
|
|
9145 (match-end 1))))
|
|
|
9146 (efs-send-cmd
|
|
|
9147 f-host f-user
|
|
|
9148 (list 'quote 'port address) nil nil
|
|
|
9149 (efs-cont (port-result port-line port-cont-lines)
|
|
|
9150 (cont f-host f-user f-host-type f-path filename
|
|
|
9151 xfer-type msg)
|
|
|
9152 (if port-result
|
|
|
9153 (if cont
|
|
|
9154 (efs-call-cont
|
|
|
9155 cont port-result port-line port-cont-lines)
|
|
|
9156 (efs-error f-host f-user
|
|
|
9157 (format "PORT failed for %s: %s"
|
|
|
9158 filename port-line)))
|
|
|
9159 (efs-send-cmd
|
|
|
9160 f-host f-user
|
|
|
9161 (list 'quote 'retr f-path xfer-type)
|
|
|
9162 msg nil
|
|
|
9163 (efs-cont (retr-result retr-line retr-cont-lines)
|
|
|
9164 (cont f-host f-user f-path)
|
|
|
9165 (and retr-result
|
|
|
9166 (null cont)
|
|
|
9167 (efs-error
|
|
|
9168 f-host f-user
|
|
|
9169 (format "RETR failed for %s: %s"
|
|
|
9170 f-path retr-line)))
|
|
|
9171 (if cont (efs-call-cont
|
|
|
9172 cont retr-result retr-line retr-cont-lines)))
|
|
|
9173 (if (eq nowait t) 1 nowait))))
|
|
|
9174 1) ; can't ever wait on this command.
|
|
|
9175 (efs-send-cmd
|
|
|
9176 t-host t-user
|
|
|
9177 (list 'quote (if append 'appe 'stor) t-path xfer-type)
|
|
|
9178 nil nil
|
|
|
9179 (efs-cont (stor-result stor-line stor-cont-lines)
|
|
|
9180 (t-host t-user t-path t-host-type newname filename
|
|
|
9181 append)
|
|
|
9182 (if stor-result
|
|
|
9183 (efs-error
|
|
|
9184 t-host t-user (format "%s failed for %s: %s"
|
|
|
9185 (if append "APPE" "STOR")
|
|
|
9186 t-path stor-line))
|
|
|
9187 (efs-copy-add-file-entry
|
|
|
9188 newname t-host-type t-user
|
|
|
9189 (nth 1 (efs-get-file-entry filename)) append)))
|
|
|
9190 (if (eq nowait t) 1 nowait))))))
|
|
|
9191 nowait)))
|
|
|
9192
|
|
|
9193 (defun efs-copy-on-remote (host user host-type filename newname filename-parsed
|
|
|
9194 newname-parsed keep-date append-p msg cont
|
|
|
9195 nowait xfer-type)
|
|
|
9196 ;; Uses site exec to copy the file on a remote host
|
|
|
9197 (let ((exec-cp (efs-get-host-property host 'exec-cp)))
|
|
|
9198 (if (or append-p
|
|
|
9199 (not (memq host-type efs-unix-host-types))
|
|
|
9200 (efs-get-host-property host 'exec-failed)
|
|
|
9201 (eq exec-cp 'failed))
|
|
|
9202 (efs-copy-via-temp filename filename-parsed newname newname-parsed
|
|
|
9203 append-p keep-date msg cont nowait xfer-type)
|
|
|
9204 (if (eq exec-cp 'works)
|
|
|
9205 (efs-send-cmd
|
|
|
9206 host user
|
|
|
9207 (list 'quote 'site 'exec
|
|
|
9208 (format "cp %s%s %s" (if keep-date "-p " "")
|
|
|
9209 (nth 2 filename-parsed) (nth 2 newname-parsed)))
|
|
|
9210 msg nil
|
|
|
9211 (efs-cont (result line cont-lines) (host user filename newname
|
|
|
9212 host-type filename-parsed
|
|
|
9213 newname-parsed
|
|
|
9214 keep-date append-p msg cont
|
|
|
9215 xfer-type nowait)
|
|
|
9216 (if result
|
|
|
9217 (progn
|
|
|
9218 (efs-set-host-property host 'exec-failed t)
|
|
|
9219 (efs-copy-via-temp filename filename-parsed newname
|
|
|
9220 newname-parsed append-p keep-date
|
|
|
9221 nil cont nowait xfer-type))
|
|
|
9222 (efs-save-match-data
|
|
|
9223 (if (string-match "\n200-\\([^\n]*\\)" cont-lines)
|
|
|
9224 (let ((err (substring cont-lines (match-beginning 1)
|
|
|
9225 (match-end 1))))
|
|
|
9226 (if cont
|
|
|
9227 (efs-call-cont cont 'failed err cont-lines)
|
|
|
9228 (efs-error host user err)))
|
|
|
9229 (efs-copy-add-file-entry
|
|
|
9230 newname host-type user
|
|
|
9231 (nth 7 (efs-file-attributes filename)) nil)
|
|
|
9232 (if cont (efs-call-cont cont nil line cont-lines))))))
|
|
|
9233 nowait)
|
|
|
9234 (message "Checking for cp executable on %s..." host)
|
|
|
9235 (efs-send-cmd
|
|
|
9236 host user (list 'quote 'site 'exec "cp / /") nil nil
|
|
|
9237 (efs-cont (result line cont-lines) (host user filename newname
|
|
|
9238 host-type filename-parsed
|
|
|
9239 newname-parsed
|
|
|
9240 keep-date append-p msg cont
|
|
|
9241 xfer-type nowait)
|
|
|
9242 (efs-save-match-data
|
|
|
9243 (if (string-match "\n200-" cont-lines)
|
|
|
9244 (efs-set-host-property host 'exec-cp 'works)
|
|
|
9245 (efs-set-host-property host 'exec-cp 'failed)))
|
|
|
9246 (efs-copy-on-remote host user host-type filename newname
|
|
|
9247 filename-parsed newname-parsed keep-date
|
|
|
9248 append-p msg cont nowait xfer-type))
|
|
|
9249 nowait)))))
|
|
|
9250
|
|
|
9251 (defun efs-copy-via-temp (filename filename-parsed newname newname-parsed
|
|
|
9252 append keep-date msg cont nowait xfer-type)
|
|
|
9253 ;; Copies from FILENAME to NEWNAME via a temp file.
|
|
|
9254 (let* ((temp (car (if (efs-use-gateway-p (car filename-parsed) t)
|
|
|
9255 (efs-make-tmp-name (car filename-parsed)
|
|
|
9256 (car newname-parsed))
|
|
|
9257 (efs-make-tmp-name (car newname-parsed)
|
|
|
9258 (car filename-parsed)))))
|
|
|
9259 (temp-parsed (efs-ftp-path temp)))
|
|
|
9260 (or xfer-type (setq xfer-type
|
|
|
9261 (efs-xfer-type
|
|
|
9262 (efs-host-type (car filename-parsed)) filename
|
|
|
9263 (efs-host-type (car newname-parsed)) newname
|
|
|
9264 t)))
|
|
|
9265 (efs-copy-file-internal
|
|
|
9266 filename filename-parsed temp temp-parsed t nil (if (eq 0 msg) 2 msg)
|
|
|
9267 (efs-cont (result line cont-lines) (newname newname-parsed temp
|
|
|
9268 temp-parsed append msg cont
|
|
|
9269 nowait xfer-type)
|
|
|
9270 (if result
|
|
|
9271 (progn
|
|
|
9272 (efs-del-tmp-name temp)
|
|
|
9273 (if cont
|
|
|
9274 (efs-call-cont cont result line cont-lines)
|
|
|
9275 (signal 'ftp-error
|
|
|
9276 (list "Opening input file"
|
|
|
9277 (format "FTP Error: \"%s\" " line) filename))))
|
|
|
9278 (efs-copy-file-internal
|
|
|
9279 temp temp-parsed newname newname-parsed (if append 'append t) nil
|
|
|
9280 (if (eq msg 0) 1 msg)
|
|
|
9281 (efs-cont (result line cont-lines) (temp newname cont)
|
|
|
9282 (efs-del-tmp-name temp)
|
|
|
9283 (if cont
|
|
|
9284 (efs-call-cont cont result line cont-lines)
|
|
|
9285 (if result
|
|
|
9286 (signal 'ftp-error
|
|
|
9287 (list "Opening output file"
|
|
|
9288 (format "FTP Error: \"%s\" " line) newname)))))
|
|
|
9289 nowait xfer-type)))
|
|
|
9290 nowait xfer-type)))
|
|
|
9291
|
|
|
9292 (defun efs-copy-file-internal (filename filename-parsed newname newname-parsed
|
|
|
9293 ok-if-already-exists keep-date
|
|
|
9294 &optional msg cont nowait xfer-type)
|
|
|
9295 ;; Internal function for copying a file from FILENAME to NEWNAME.
|
|
|
9296 ;; FILENAME-PARSED and NEWNAME-PARSED are the lists obtained by parsing
|
|
|
9297 ;; FILENAME and NEWNAME with efs-ftp-path.
|
|
|
9298 ;; If OK-IF-ALREADY-EXISTS is nil, then existing files will not be
|
|
|
9299 ;; overwritten.
|
|
|
9300 ;; If it is a number, then the user will be prompted about overwriting.
|
|
|
9301 ;; If it eq 'append, then an existing file will be appended to.
|
|
|
9302 ;; If it has anyother value, then existing files will be silently
|
|
|
9303 ;; overwritten.
|
|
|
9304 ;; If KEEP-DATE is t then we will attempt to reatin the date of the
|
|
|
9305 ;; original copy of the file. If this is a string, the modtime of the
|
|
|
9306 ;; NEWNAME will be set to this date. Must be in touch -t format.
|
|
|
9307 ;; If MSG is nil, then the copying will be done silently.
|
|
|
9308 ;; If it is a string, then that will be the massage displayed while copying.
|
|
|
9309 ;; If it is 0, then a suitable default message will be computed.
|
|
|
9310 ;; If it is 1, then a suitable default will be computed, assuming
|
|
|
9311 ;; that FILENAME is a temporary file, whose name is not suitable to use
|
|
|
9312 ;; in a status message.
|
|
|
9313 ;; If it is 2, then a suitable default will be used, assuming that
|
|
|
9314 ;; NEWNAME is a temporary file.
|
|
|
9315 ;; CONT is a continuation to call after completing the copy.
|
|
|
9316 ;; The first two args are RESULT and LINE, the result symbol and status
|
|
|
9317 ;; line of the FTP command. If more than one ftp command has been used,
|
|
|
9318 ;; then these values for the last FTP command are given.
|
|
|
9319 ;; NOWAIT can be either nil, 0, 1, t. See `efs-send-cmd' for an explanation.
|
|
|
9320 ;; XFER-TYPE is the transfer type to use for transferring the files.
|
|
|
9321 ;; If this is nil, than a suitable transfer type is computed.
|
|
|
9322 ;; Does not call expand-file-name. Do that yourself.
|
|
|
9323
|
|
|
9324 ;; check to see if we can overwrite
|
|
|
9325 (if (or (not ok-if-already-exists)
|
|
|
9326 (numberp ok-if-already-exists))
|
|
|
9327 (efs-barf-or-query-if-file-exists
|
|
|
9328 newname "copy to it" (numberp ok-if-already-exists)))
|
|
|
9329 (if (null (or filename-parsed newname-parsed))
|
|
|
9330 ;; local to local copy
|
|
|
9331 (progn
|
|
|
9332 (if (eq ok-if-already-exists 'append)
|
|
|
9333 (efs-concatenate-files filename newname)
|
|
|
9334 (copy-file filename newname ok-if-already-exists keep-date))
|
|
|
9335 (if cont
|
|
|
9336 (efs-call-cont cont nil "Copied locally" "")))
|
|
|
9337 (let* ((f-host (car filename-parsed))
|
|
|
9338 (f-user (nth 1 filename-parsed))
|
|
|
9339 (f-path (nth 2 filename-parsed))
|
|
|
9340 (f-host-type (efs-host-type f-host f-user))
|
|
|
9341 (f-gate-p (efs-use-gateway-p f-host t))
|
|
|
9342 (t-host (car newname-parsed))
|
|
|
9343 (t-user (nth 1 newname-parsed))
|
|
|
9344 (t-path (nth 2 newname-parsed))
|
|
|
9345 (t-host-type (efs-host-type t-host t-user))
|
|
|
9346 (t-gate-p (efs-use-gateway-p t-host t))
|
|
|
9347 (append-p (eq ok-if-already-exists 'append))
|
|
|
9348 gatename)
|
|
|
9349
|
|
|
9350 (if (and (eq keep-date t) (null newname-parsed))
|
|
|
9351 ;; f-host must be remote now.
|
|
|
9352 (setq keep-date filename))
|
|
|
9353
|
|
|
9354 (cond
|
|
|
9355
|
|
|
9356 ;; Check to see if we can do a PUT
|
|
|
9357 ((or
|
|
|
9358 (and (null f-host)
|
|
|
9359 (or (null t-gate-p)
|
|
|
9360 (setq gatename (efs-local-to-gateway-filename filename))))
|
|
|
9361 (and t-gate-p
|
|
|
9362 f-host
|
|
|
9363 (string-equal (downcase f-host) (downcase efs-gateway-host))
|
|
|
9364 (if (memq f-host-type efs-case-insensitive-host-types)
|
|
|
9365 (string-equal (downcase f-user)
|
|
|
9366 (downcase (efs-get-user efs-gateway-host)))
|
|
|
9367 (string-equal f-user (efs-get-user efs-gateway-host)))))
|
|
|
9368 (or f-host (let (file-name-handler-alist)
|
|
|
9369 (if (file-exists-p filename)
|
|
|
9370 (cond
|
|
|
9371 ((file-directory-p filename)
|
|
|
9372 (signal 'file-error
|
|
|
9373 (list "Non-regular file"
|
|
|
9374 "is a directory" filename)))
|
|
|
9375 ((not (file-readable-p filename))
|
|
|
9376 (signal 'file-error
|
|
|
9377 (list "Opening input file"
|
|
|
9378 "permission denied" filename))))
|
|
|
9379 (signal 'file-error
|
|
|
9380 (list "Opening input file"
|
|
|
9381 "no such file or directory" filename)))))
|
|
|
9382 (or xfer-type
|
|
|
9383 (setq xfer-type
|
|
|
9384 (efs-xfer-type f-host-type filename t-host-type newname)))
|
|
|
9385 (let ((size (and (or (null f-host-type)
|
|
|
9386 (efs-file-entry-p filename))
|
|
|
9387 (nth 7 (file-attributes filename)))))
|
|
|
9388 ;; -1 is a bogus size for remote files
|
|
|
9389 (if (eq size -1) (setq size nil))
|
|
|
9390 (efs-send-cmd
|
|
|
9391 t-host t-user
|
|
|
9392 (list (if append-p 'append 'put)
|
|
|
9393 (if f-host
|
|
|
9394 f-path
|
|
|
9395 (or gatename filename))
|
|
|
9396 t-path
|
|
|
9397 xfer-type)
|
|
|
9398 (cond ((eq msg 2)
|
|
|
9399 (concat (if append-p "Appending " "Putting ")
|
|
|
9400 (efs-relativize-filename filename)))
|
|
|
9401 ((eq msg 1)
|
|
|
9402 (concat (if append-p "Appending " "Putting ")
|
|
|
9403 (efs-relativize-filename newname)))
|
|
|
9404 ((eq msg 0)
|
|
|
9405 (concat (if append-p "Appending " "Copying ")
|
|
|
9406 (efs-relativize-filename filename)
|
|
|
9407 " to "
|
|
|
9408 (efs-relativize-filename
|
|
|
9409 newname (file-name-directory filename) filename)))
|
|
|
9410 (t msg))
|
|
|
9411 (and size (list 'efs-set-xfer-size t-host t-user size))
|
|
|
9412 (efs-cont (result line cont-lines) (newname t-host-type t-user size
|
|
|
9413 append-p cont)
|
|
|
9414 (if result
|
|
|
9415 (if cont
|
|
|
9416 (efs-call-cont cont result line cont-lines)
|
|
|
9417 (signal 'ftp-error
|
|
|
9418 (list "Opening output file"
|
|
|
9419 (format "FTP Error: \"%s\" " line) newname)))
|
|
|
9420 ;; add file entry
|
|
|
9421 (efs-copy-add-file-entry newname t-host-type t-user
|
|
|
9422 size append-p)
|
|
|
9423 (if cont
|
|
|
9424 (efs-call-cont cont result line cont-lines))))
|
|
|
9425 nowait)))
|
|
|
9426
|
|
|
9427 ;; Check to see if we can do a GET
|
|
|
9428 ((and
|
|
|
9429 ;; I think that giving the append arg, will cause this function
|
|
|
9430 ;; to make a temp file, recursively call itself, and append the temp
|
|
|
9431 ;; file to the local file. Hope it works out...
|
|
|
9432 (null append-p)
|
|
|
9433 (or
|
|
|
9434 (and (null t-host)
|
|
|
9435 (or (null f-gate-p)
|
|
|
9436 (setq gatename (efs-local-to-gateway-filename newname))))
|
|
|
9437 (and f-gate-p
|
|
|
9438 t-host
|
|
|
9439 (string-equal (downcase t-host) (downcase efs-gateway-host))
|
|
|
9440 (if (memq t-host-type efs-case-insensitive-host-types)
|
|
|
9441 (string-equal (downcase t-user)
|
|
|
9442 (downcase (efs-get-user efs-gateway-host)))
|
|
|
9443 (string-equal t-user (efs-get-user efs-gateway-host))))))
|
|
|
9444 (or t-host (let (file-name-handler-alist)
|
|
|
9445 (cond ((not (file-writable-p newname))
|
|
|
9446 (signal 'file-error
|
|
|
9447 (list "Opening output file"
|
|
|
9448 "permission denied" newname)))
|
|
|
9449 ((file-directory-p newname)
|
|
|
9450 (signal 'file-error
|
|
|
9451 (list "Opening output file"
|
|
|
9452 "is a directory" newname))))))
|
|
|
9453 (or xfer-type
|
|
|
9454 (setq xfer-type
|
|
|
9455 (efs-xfer-type f-host-type filename t-host-type newname)))
|
|
|
9456 (let ((size (and (or (null f-host-type)
|
|
|
9457 (efs-file-entry-p filename))
|
|
|
9458 (nth 7 (file-attributes filename)))))
|
|
|
9459 ;; -1 is a bogus size for remote files.
|
|
|
9460 (if (eq size -1) (setq size nil))
|
|
|
9461 (efs-send-cmd
|
|
|
9462 f-host f-user
|
|
|
9463 (list 'get
|
|
|
9464 f-path
|
|
|
9465 (if t-host
|
|
|
9466 t-path
|
|
|
9467 (or gatename newname))
|
|
|
9468 xfer-type)
|
|
|
9469 (cond ((eq msg 0)
|
|
|
9470 (concat "Copying "
|
|
|
9471 (efs-relativize-filename filename)
|
|
|
9472 " to "
|
|
|
9473 (efs-relativize-filename
|
|
|
9474 newname (file-name-directory filename) filename)))
|
|
|
9475 ((eq msg 2)
|
|
|
9476 (concat "Getting " (efs-relativize-filename filename)))
|
|
|
9477 ((eq msg 1)
|
|
|
9478 (concat "Getting " (efs-relativize-filename newname)))
|
|
|
9479 (t msg))
|
|
|
9480 ;; If the server emits a efs-xfer-size-msgs, it will over-ride this.
|
|
|
9481 ;; With no xfer msg, this is will do the job.
|
|
|
9482 (and size (list 'efs-set-xfer-size f-host f-user size))
|
|
|
9483 (efs-cont (result line cont-lines) (filename newname size
|
|
|
9484 t-host-type t-user
|
|
|
9485 cont keep-date)
|
|
|
9486 (if result
|
|
|
9487 (if cont
|
|
|
9488 (efs-call-cont cont result line cont-lines)
|
|
|
9489 (signal 'ftp-error
|
|
|
9490 (list "Opening input file"
|
|
|
9491 (format "FTP Error: \"%s\" " line) filename)))
|
|
|
9492 ;; Add a new file entry, if relevant.
|
|
|
9493 (if t-host-type
|
|
|
9494 ;; t-host will be equal to efs-gateway-host, if t-host-type
|
|
|
9495 ;; is non-nil.
|
|
|
9496 (efs-copy-add-file-entry newname t-host-type
|
|
|
9497 t-user size nil))
|
|
|
9498 (if (and (null t-host-type) (stringp keep-date))
|
|
|
9499 (efs-set-mdtm-of
|
|
|
9500 filename newname
|
|
|
9501 (and cont
|
|
|
9502 (efs-cont (result1 line1 cont-lines1) (result
|
|
|
9503 line cont-lines
|
|
|
9504 cont)
|
|
|
9505 (efs-call-cont cont result line cont-lines))))
|
|
|
9506 (if cont
|
|
|
9507 (efs-call-cont cont result line cont-lines)))))
|
|
|
9508 nowait)))
|
|
|
9509
|
|
|
9510 ;; Can we do a EXEC cp?
|
|
|
9511 ((and t-host f-host
|
|
|
9512 (string-equal (downcase t-host) (downcase f-host))
|
|
|
9513 (if (memq t-host-type efs-case-insensitive-host-types)
|
|
|
9514 (string-equal (downcase t-user) (downcase f-user))
|
|
|
9515 (string-equal t-user f-user)))
|
|
|
9516 (efs-copy-on-remote
|
|
|
9517 t-host t-user t-host-type filename newname filename-parsed
|
|
|
9518 newname-parsed keep-date append-p
|
|
|
9519 (cond ((eq msg 0)
|
|
|
9520 (concat "Copying "
|
|
|
9521 (efs-relativize-filename filename)
|
|
|
9522 " to "
|
|
|
9523 (efs-relativize-filename
|
|
|
9524 newname (file-name-directory filename) filename)))
|
|
|
9525 ((eq msg 1)
|
|
|
9526 (concat "Copying " (efs-relativize-filename newname)))
|
|
|
9527 ((eq msg 2)
|
|
|
9528 (concat "Copying " (efs-relativize-filename filename)))
|
|
|
9529 (t msg))
|
|
|
9530 cont nowait xfer-type))
|
|
|
9531
|
|
|
9532 ;; Try for a copy with PASV
|
|
|
9533 ((and t-host f-host
|
|
|
9534 (not (and (string-equal (downcase t-host) (downcase f-host))
|
|
|
9535 (if (memq t-host-type efs-case-insensitive-host-types)
|
|
|
9536 (string-equal (downcase t-user) (downcase f-user))
|
|
|
9537 (string-equal t-user f-user))))
|
|
|
9538 (or
|
|
|
9539 (and efs-gateway-host
|
|
|
9540 ;; The gateway should be able to talk to anything.
|
|
|
9541 (let ((gh (downcase efs-gateway-host)))
|
|
|
9542 (or (string-equal (downcase t-host) gh)
|
|
|
9543 (string-equal (downcase f-host) gh))))
|
|
|
9544 (efs-save-match-data
|
|
|
9545 (eq (null (string-match efs-local-host-regexp t-host))
|
|
|
9546 (null (string-match efs-local-host-regexp f-host))))))
|
|
|
9547 (efs-copy-remote-to-remote
|
|
|
9548 f-host-type f-host f-user f-path filename
|
|
|
9549 t-host-type t-host t-user t-path newname
|
|
|
9550 append-p
|
|
|
9551 (cond ((eq msg 0)
|
|
|
9552 (concat "Copying "
|
|
|
9553 (efs-relativize-filename filename)
|
|
|
9554 " to "
|
|
|
9555 (efs-relativize-filename
|
|
|
9556 newname (file-name-directory filename) filename)))
|
|
|
9557 ((eq msg 1)
|
|
|
9558 (concat "Copying " (efs-relativize-filename newname)))
|
|
|
9559 ((eq msg 2)
|
|
|
9560 (concat "Copying " (efs-relativize-filename filename)))
|
|
|
9561 (t msg))
|
|
|
9562 (efs-cont (result line cont-lines)
|
|
|
9563 (filename filename-parsed newname newname-parsed
|
|
|
9564 append-p keep-date msg cont nowait xfer-type)
|
|
|
9565 (if result
|
|
|
9566 ;; PASV didn't work. Do things the old-fashioned
|
|
|
9567 ;; way.
|
|
|
9568 (efs-copy-via-temp
|
|
|
9569 filename filename-parsed newname newname-parsed
|
|
|
9570 append-p keep-date msg cont nowait xfer-type)
|
|
|
9571 (if cont
|
|
|
9572 (efs-call-cont cont result line cont-lines))))
|
|
|
9573 nowait xfer-type))
|
|
|
9574
|
|
|
9575 ;; Can't do anything direct. Divide and conquer.
|
|
|
9576 (t
|
|
|
9577 (efs-copy-via-temp filename filename-parsed newname newname-parsed
|
|
|
9578 append-p keep-date msg cont nowait xfer-type))))))
|
|
|
9579
|
|
|
9580 (defun efs-copy-file (filename newname &optional ok-if-already-exists
|
|
|
9581 keep-date nowait)
|
|
|
9582 ;; Version of copy file for remote files. Actually, will also work
|
|
|
9583 ;; for local files too, since efs-copy-file-internal can copy anything.
|
|
|
9584 ;; If called interactively, copies asynchronously.
|
|
|
9585 (setq filename (expand-file-name filename)
|
|
|
9586 newname (expand-file-name newname))
|
|
|
9587 (if (eq ok-if-already-exists 'append)
|
|
|
9588 (setq ok-if-already-exists t))
|
|
|
9589 (efs-copy-file-internal filename (efs-ftp-path filename)
|
|
|
9590 newname (efs-ftp-path newname)
|
|
|
9591 ok-if-already-exists keep-date 0 nil nowait))
|
|
|
9592
|
|
|
9593 ;;;; ------------------------------------------------------------
|
|
|
9594 ;;;; File renaming support.
|
|
|
9595 ;;;; ------------------------------------------------------------
|
|
|
9596
|
|
|
9597 (defun efs-rename-get-file-list (dir ent)
|
|
|
9598 ;; From hashtable ENT for DIR returns a list of all files except "."
|
|
|
9599 ;; and "..".
|
|
|
9600 (let (list)
|
|
|
9601 (efs-map-hashtable
|
|
|
9602 (function
|
|
|
9603 (lambda (key val)
|
|
|
9604 (or (string-equal "." key) (string-equal ".." key)
|
|
|
9605 (setq list
|
|
|
9606 (cons (expand-file-name key dir) list)))))
|
|
|
9607 ent)
|
|
|
9608 list))
|
|
|
9609
|
|
|
9610 (defun efs-rename-get-files (dir cont nowait)
|
|
|
9611 ;; Obtains a list of files in directory DIR (except . and ..), and applies
|
|
|
9612 ;; CONT to the list. Doesn't return anything useful.
|
|
|
9613 (let* ((dir (file-name-as-directory dir))
|
|
|
9614 (ent (efs-get-files-hashtable-entry dir)))
|
|
|
9615 (if ent
|
|
|
9616 (efs-call-cont cont (efs-rename-get-file-list dir ent))
|
|
|
9617 (efs-ls
|
|
|
9618 dir (efs-ls-guess-switches) t nil t nowait
|
|
|
9619 (efs-cont (listing) (dir cont)
|
|
|
9620 (efs-call-cont
|
|
|
9621 cont (and listing
|
|
|
9622 (efs-rename-get-file-list
|
|
|
9623 dir (efs-get-files-hashtable-entry dir)))))))))
|
|
|
9624
|
|
|
9625 (defun efs-rename-get-local-file-tree (dir)
|
|
|
9626 ;; Returns a list of the full directory tree under DIR, for DIR on the
|
|
|
9627 ;; local host. The list is in tree order.
|
|
|
9628 (let ((res (list dir)))
|
|
|
9629 (mapcar
|
|
|
9630 (function
|
|
|
9631 (lambda (file)
|
|
|
9632 (if (file-directory-p file)
|
|
|
9633 (nconc res (delq nil (mapcar
|
|
|
9634 (function
|
|
|
9635 (lambda (f)
|
|
|
9636 (and (not (string-equal "." f))
|
|
|
9637 (not (string-equal ".." f))
|
|
|
9638 (expand-file-name f file))))
|
|
|
9639 (directory-files file)))))))
|
|
|
9640 res)
|
|
|
9641 res))
|
|
|
9642
|
|
|
9643 (defun efs-rename-get-remote-file-tree (next curr total cont nowait)
|
|
|
9644 ;; Builds a hierarchy of files.
|
|
|
9645 ;; NEXT is the next level so far.
|
|
|
9646 ;; CURR are unprocessed files in the current level.
|
|
|
9647 ;; TOTAL is the processed files so far.
|
|
|
9648 ;; CONT is a cont. function called on the total list after all files
|
|
|
9649 ;; are processed.
|
|
|
9650 ;; NOWAIT non-nil means run asynch.
|
|
|
9651 (or curr (setq curr next
|
|
|
9652 next nil))
|
|
|
9653 (if curr
|
|
|
9654 (let ((file (car curr)))
|
|
|
9655 (setq curr (cdr curr)
|
|
|
9656 total (cons file total))
|
|
|
9657 (if (file-directory-p file)
|
|
|
9658 (efs-rename-get-files
|
|
|
9659 file
|
|
|
9660 (efs-cont (list) (next curr total cont nowait)
|
|
|
9661 (efs-rename-get-remote-file-tree (nconc next list)
|
|
|
9662 curr total cont nowait))
|
|
|
9663 nowait)
|
|
|
9664 (efs-rename-get-remote-file-tree next curr total cont nowait)))
|
|
|
9665 (efs-call-cont cont (nreverse total))))
|
|
|
9666
|
|
|
9667 (defun efs-rename-make-targets (files from-dir-len to-dir host user host-type
|
|
|
9668 cont nowait)
|
|
|
9669 ;; Make targets (copy a file or make a subdir) on local or host
|
|
|
9670 ;; for the files in list. Afterwhich, call CONT.
|
|
|
9671 (if files
|
|
|
9672 (let* ((from (car files))
|
|
|
9673 (files (cdr files))
|
|
|
9674 (to (concat to-dir (substring from from-dir-len))))
|
|
|
9675 (if (file-directory-p from)
|
|
|
9676 (if host-type
|
|
|
9677 (let ((dir (nth 2 (efs-ftp-path to))))
|
|
|
9678 (or (memq host-type efs-unix-host-types)
|
|
|
9679 (memq host-type '(dos os2))
|
|
|
9680 (setq dir (efs-internal-file-name-as-directory nil dir)))
|
|
|
9681 (efs-send-cmd
|
|
|
9682 host user (list 'mkdir dir)
|
|
|
9683 (format "Making directory %s" (efs-relativize-filename to))
|
|
|
9684 nil
|
|
|
9685 (efs-cont (res line cont-lines) (to files from-dir-len
|
|
|
9686 to-dir host user
|
|
|
9687 host-type cont nowait)
|
|
|
9688 (if res
|
|
|
9689 (if cont
|
|
|
9690 (efs-call-cont cont res line cont-lines)
|
|
|
9691 (signal 'ftp-error
|
|
|
9692 (list "Making directory"
|
|
|
9693 (format "FTP Error: \"%s\"" line)
|
|
|
9694 to)))
|
|
|
9695 (efs-rename-make-targets
|
|
|
9696 files from-dir-len to-dir host user
|
|
|
9697 host-type cont nowait)))
|
|
|
9698 nowait))
|
|
|
9699 (condition-case nil
|
|
|
9700 (make-directory-internal to)
|
|
|
9701 (error (efs-call-cont
|
|
|
9702 cont 'failed (format "Failed to mkdir %s" to) "")))
|
|
|
9703 (efs-rename-make-targets
|
|
|
9704 files from-dir-len to-dir host user host-type cont nowait))
|
|
|
9705 (efs-copy-file-internal
|
|
|
9706 from (efs-ftp-path from) to (and host-type (efs-ftp-path to)) nil t
|
|
|
9707 (format "Renaming %s to %s" (efs-relativize-filename from)
|
|
|
9708 (efs-relativize-filename to))
|
|
|
9709 (efs-cont (res line cont-lines) (from to files from-dir-len to-dir
|
|
|
9710 host user host-type cont
|
|
|
9711 nowait)
|
|
|
9712 (if res
|
|
|
9713 (if cont
|
|
|
9714 (efs-call-cont cont res line cont-lines)
|
|
|
9715 (signal 'ftp-error
|
|
|
9716 (list "Renaming"
|
|
|
9717 (format "FTP Error: \"%s\"" line) from to)))
|
|
|
9718 (efs-rename-make-targets
|
|
|
9719 files from-dir-len to-dir host user host-type cont nowait)))
|
|
|
9720 nowait)))
|
|
|
9721 (if cont (efs-call-cont cont nil "" ""))))
|
|
|
9722
|
|
|
9723 (defun efs-rename-delete-on-local (files)
|
|
|
9724 ;; Delete the files FILES, and then run CONT.
|
|
|
9725 ;; FILES are assumed to be in inverse tree order.
|
|
|
9726 (message "Deleting files...")
|
|
|
9727 (mapcar
|
|
|
9728 (function
|
|
|
9729 (lambda (f)
|
|
|
9730 (condition-case nil
|
|
|
9731 (if (file-directory-p f)
|
|
|
9732 (delete-directory f)
|
|
|
9733 (delete-file f))
|
|
|
9734 (file-error nil)))) ; don't complain if the file is already gone.
|
|
|
9735 files)
|
|
|
9736 (message "Deleting files...done"))
|
|
|
9737
|
|
|
9738 (defun efs-rename-delete-on-remote (files host user host-type cont nowait)
|
|
|
9739 ;; Deletes the list FILES on a remote host. When done calls CONT.
|
|
|
9740 ;; FILES is assumed to be in reverse tree order.
|
|
|
9741 (if files
|
|
|
9742 (let* ((f (car files))
|
|
|
9743 (rf (nth 2 (efs-ftp-path f))))
|
|
|
9744 (progn
|
|
|
9745 (setq files (cdr files))
|
|
|
9746 (if (file-directory-p f)
|
|
|
9747 (let ((rf (if (memq host-type (append efs-unix-host-types
|
|
|
9748 '(dos os2)))
|
|
|
9749 (efs-internal-directory-file-name f)
|
|
|
9750 (efs-internal-file-name-as-directory nil f))))
|
|
|
9751
|
|
|
9752 (efs-send-cmd
|
|
|
9753 host user (list 'rmdir rf)
|
|
|
9754 (concat "Deleting directory " (efs-relativize-filename f))
|
|
|
9755 nil
|
|
|
9756 (efs-cont (res line cont-lines) (f files host user host-type
|
|
|
9757 cont nowait)
|
|
|
9758 (if (and res
|
|
|
9759 (efs-save-match-data
|
|
|
9760 (not (string-match "^550 " line))))
|
|
|
9761 (if cont
|
|
|
9762 (efs-call-cont cont res line cont-lines)
|
|
|
9763 (signal 'ftp-error
|
|
|
9764 (list "Deleting directory"
|
|
|
9765 (format "FTP Error: \"%s\"" line)
|
|
|
9766 f)))
|
|
|
9767 (efs-rename-delete-on-remote
|
|
|
9768 files host user host-type cont nowait)))
|
|
|
9769 nowait))
|
|
|
9770 (efs-send-cmd
|
|
|
9771 host user (list 'delete rf)
|
|
|
9772 (concat "Deleting " rf)
|
|
|
9773 nil
|
|
|
9774 (efs-cont (res line cont-lines) (f files host user host-type
|
|
|
9775 cont nowait)
|
|
|
9776 (if (and res
|
|
|
9777 (efs-save-match-data
|
|
|
9778 (not (string-match "^550 " line))))
|
|
|
9779 (if cont
|
|
|
9780 (efs-call-cont cont res line cont-lines)
|
|
|
9781 (signal 'ftp-error
|
|
|
9782 (list "Deleting"
|
|
|
9783 (format "FTP Error: \"%s\"" line)
|
|
|
9784 f)))
|
|
|
9785 (efs-rename-delete-on-remote
|
|
|
9786 files host user host-type cont nowait)))
|
|
|
9787 nowait))))
|
|
|
9788 (if cont (efs-call-cont cont nil "" ""))))
|
|
|
9789
|
|
|
9790 (defun efs-rename-on-remote (host user old-path new-path old-file new-file
|
|
|
9791 msg nowait cont)
|
|
|
9792 ;; Run a rename command on the remote server.
|
|
|
9793 ;; OLD-PATH and NEW-PATH are in full efs syntax.
|
|
|
9794 ;; OLD-FILE and NEW-FILE are the remote full pathnames, not in efs syntax.
|
|
|
9795 (efs-send-cmd
|
|
|
9796 host user (list 'rename old-file new-file) msg nil
|
|
|
9797 (efs-cont (result line cont-lines) (cont old-path new-path host)
|
|
|
9798 (if result
|
|
|
9799 (progn
|
|
|
9800 (or (and (>= (length line) 4)
|
|
|
9801 (string-equal "550 " (substring line 0 4)))
|
|
|
9802 (efs-set-host-property host 'rnfr-failed t))
|
|
|
9803 (if cont
|
|
|
9804 (efs-call-cont cont result line cont-lines)
|
|
|
9805 (signal 'ftp-error
|
|
|
9806 (list "Renaming"
|
|
|
9807 (format "FTP Error: \"%s\"" line)
|
|
|
9808 old-path new-path))))
|
|
|
9809 (let ((entry (efs-get-file-entry old-path))
|
|
|
9810 (host-type (efs-host-type host))
|
|
|
9811 ;; If no file entry, do extra work on the hashtable,
|
|
|
9812 ;; rather than force a listing.
|
|
|
9813 (dir-p (or (not (efs-file-entry-p old-path))
|
|
|
9814 (file-directory-p old-path))))
|
|
|
9815 (apply 'efs-add-file-entry host-type new-path
|
|
|
9816 (eq (car entry) t) (cdr entry))
|
|
|
9817 (efs-delete-file-entry host-type old-path)
|
|
|
9818 (if dir-p
|
|
|
9819 (let* ((old (efs-canonize-file-name
|
|
|
9820 (file-name-as-directory old-path)))
|
|
|
9821 (new (efs-canonize-file-name
|
|
|
9822 (file-name-as-directory new-path)))
|
|
|
9823 (old-len (length old))
|
|
|
9824 (new-tbl (efs-make-hashtable
|
|
|
9825 (length efs-files-hashtable))))
|
|
|
9826 (efs-map-hashtable
|
|
|
9827 (function
|
|
|
9828 (lambda (key val)
|
|
|
9829 (if (and (>= (length key) old-len)
|
|
|
9830 (string-equal (substring key 0 old-len)
|
|
|
9831 old))
|
|
|
9832 (efs-put-hash-entry
|
|
|
9833 (concat new (substring key old-len)) val new-tbl)
|
|
|
9834 (efs-put-hash-entry key val new-tbl))))
|
|
|
9835 efs-files-hashtable)
|
|
|
9836 (setq efs-files-hashtable new-tbl)))
|
|
|
9837 (if cont (efs-call-cont cont result line cont-lines)))))
|
|
|
9838 nowait))
|
|
|
9839
|
|
|
9840 (defun efs-rename-local-to-remote (filename newname newname-parsed
|
|
|
9841 msg cont nowait)
|
|
|
9842 ;; Renames a file from the local host to a remote host.
|
|
|
9843 (if (file-directory-p filename)
|
|
|
9844 (let* ((files (efs-rename-get-local-file-tree filename))
|
|
|
9845 (to-dir (directory-file-name newname))
|
|
|
9846 (filename (directory-file-name filename))
|
|
|
9847 (len (length filename))
|
|
|
9848 (t-parsed (efs-ftp-path to-dir))
|
|
|
9849 (host (car t-parsed))
|
|
|
9850 (user (nth 1 t-parsed))
|
|
|
9851 (host-type (efs-host-type host)))
|
|
|
9852 ;; MSG is never passed here, instead messages are constructed
|
|
|
9853 ;; internally. I don't know how to use a single message
|
|
|
9854 ;; in a function which sends so many FTP commands.
|
|
|
9855 (efs-rename-make-targets
|
|
|
9856 files len to-dir host user host-type
|
|
|
9857 (efs-cont (result line cont-lines) (files filename newname cont)
|
|
|
9858 (if result
|
|
|
9859 (if cont
|
|
|
9860 (efs-call-cont cont result line cont-lines)
|
|
|
9861 (signal 'ftp-error
|
|
|
9862 (list "Renaming" (format "FTP Error: \"%s\"" line)
|
|
|
9863 filename newname)))
|
|
|
9864 (efs-rename-delete-on-local (nreverse files))
|
|
|
9865 (if cont (efs-call-cont cont result line cont-lines))))
|
|
|
9866 nowait))
|
|
|
9867 (efs-copy-file-internal
|
|
|
9868 filename nil newname newname-parsed t t msg
|
|
|
9869 (efs-cont (result line cont-lines) (filename cont)
|
|
|
9870 (if result
|
|
|
9871 (if cont
|
|
|
9872 (efs-call-cont cont result line cont-lines)
|
|
|
9873 (signal 'ftp-error
|
|
|
9874 (list "Renaming"
|
|
|
9875 (format "FTP Error: \"%s\"" line)
|
|
|
9876 filename newname)))
|
|
|
9877 (condition-case nil
|
|
|
9878 (delete-file filename)
|
|
|
9879 (error nil))
|
|
|
9880 (if cont (efs-call-cont cont result line cont-lines))))
|
|
|
9881 nowait)))
|
|
|
9882
|
|
|
9883 (defun efs-rename-from-remote (filename filename-parsed newname newname-parsed
|
|
|
9884 msg cont nowait)
|
|
|
9885 (let ((f-host (car filename-parsed))
|
|
|
9886 (f-user (nth 1 filename-parsed))
|
|
|
9887 (fast-nowait (if (eq nowait t) 1 nowait)))
|
|
|
9888 (if (file-directory-p filename)
|
|
|
9889 (let* ((t-host (car newname-parsed))
|
|
|
9890 (t-user (nth 1 newname-parsed))
|
|
|
9891 (t-host-type (and t-host (efs-host-type t-host)))
|
|
|
9892 (f-host-type (efs-host-type f-host)))
|
|
|
9893 (efs-rename-get-remote-file-tree
|
|
|
9894 nil (list filename) nil
|
|
|
9895 (efs-cont (list) (filename filename-parsed newname t-host t-user
|
|
|
9896 t-host-type f-host f-user f-host-type
|
|
|
9897 cont fast-nowait)
|
|
|
9898 (efs-rename-make-targets
|
|
|
9899 list (length filename) newname t-host t-user t-host-type
|
|
|
9900 (efs-cont (res line cont-lines) (filename newname f-host f-user
|
|
|
9901 f-host-type list cont
|
|
|
9902 fast-nowait)
|
|
|
9903 (if res
|
|
|
9904 (if cont
|
|
|
9905 (efs-call-cont cont res line cont-lines)
|
|
|
9906 (signal 'ftp-error
|
|
|
9907 (list "Renaming"
|
|
|
9908 (format "FTP Error: \"%s\"" line)
|
|
|
9909 filename newname)))
|
|
|
9910 (efs-rename-delete-on-remote
|
|
|
9911 (nreverse list) f-host f-user f-host-type cont
|
|
|
9912 fast-nowait)))
|
|
|
9913 fast-nowait)) nowait))
|
|
|
9914 ;; Do things the simple way.
|
|
|
9915 (let ((f-path (nth 2 filename-parsed))
|
|
|
9916 (f-abbr (efs-relativize-filename filename)))
|
|
|
9917 (efs-copy-file-internal
|
|
|
9918 filename filename-parsed newname newname-parsed t t msg
|
|
|
9919 (efs-cont (result line cont-lines) (filename newname f-host f-user
|
|
|
9920 f-path f-abbr
|
|
|
9921 cont fast-nowait)
|
|
|
9922 (if result
|
|
|
9923 (if cont
|
|
|
9924 (efs-call-cont cont result line cont-lines)
|
|
|
9925 (signal 'ftp-error
|
|
|
9926 (list "Renaming"
|
|
|
9927 (format "FTP Error: \"%s\"" line)
|
|
|
9928 filename newname)))
|
|
|
9929 (efs-send-cmd
|
|
|
9930 f-host f-user (list 'delete f-path)
|
|
|
9931 (format "Removing %s" f-abbr) nil
|
|
|
9932 (efs-cont (result line cont-lines) (filename f-host cont)
|
|
|
9933 (if result
|
|
|
9934 (if cont
|
|
|
9935 (efs-call-cont cont result line cont-lines)
|
|
|
9936 (signal 'ftp-error
|
|
|
9937 (list "Renaming"
|
|
|
9938 (format "Failed to remove %s"
|
|
|
9939 filename)
|
|
|
9940 "FTP Error: \"%s\"" line)))
|
|
|
9941 (efs-delete-file-entry (efs-host-type f-host)
|
|
|
9942 filename)
|
|
|
9943 (if cont
|
|
|
9944 (efs-call-cont cont result line cont-lines))))
|
|
|
9945 fast-nowait))) nowait)))))
|
|
|
9946
|
|
|
9947 (defun efs-rename-file-internal (filename newname ok-if-already-exists
|
|
|
9948 &optional msg cont nowait)
|
|
|
9949 ;; Internal version of rename-file for remote files.
|
|
|
9950 ;; Takes CONT and NOWAIT args.
|
|
|
9951 (let ((filename (expand-file-name filename))
|
|
|
9952 (newname (expand-file-name newname)))
|
|
|
9953 (let ((f-parsed (efs-ftp-path filename))
|
|
|
9954 (t-parsed (efs-ftp-path newname)))
|
|
|
9955 (if (null (or f-parsed t-parsed))
|
|
|
9956 (progn
|
|
|
9957 ;; local rename
|
|
|
9958 (rename-file filename newname ok-if-already-exists)
|
|
|
9959 (if cont
|
|
|
9960 (efs-call-cont cont nil "Renamed locally" "")))
|
|
|
9961
|
|
|
9962 ;; check to see if we can overwrite
|
|
|
9963 (if (or (not ok-if-already-exists)
|
|
|
9964 (numberp ok-if-already-exists))
|
|
|
9965 (efs-barf-or-query-if-file-exists
|
|
|
9966 newname "rename to it" (numberp ok-if-already-exists)))
|
|
|
9967
|
|
|
9968 (let ((f-abbr (efs-relativize-filename filename))
|
|
|
9969 (t-abbr (efs-relativize-filename newname
|
|
|
9970 (file-name-directory filename)
|
|
|
9971 filename)))
|
|
|
9972 (or msg (setq msg (format "Renaming %s to %s" f-abbr t-abbr)))
|
|
|
9973 (if f-parsed
|
|
|
9974 (let* ((f-host (car f-parsed))
|
|
|
9975 (f-user (nth 1 f-parsed))
|
|
|
9976 (f-path (nth 2 f-parsed))
|
|
|
9977 (f-host-type (efs-host-type f-host)))
|
|
|
9978 (if (and t-parsed
|
|
|
9979 (string-equal (downcase f-host)
|
|
|
9980 (downcase (car t-parsed)))
|
|
|
9981 (not (efs-get-host-property f-host 'rnfr-failed))
|
|
|
9982 (if (memq f-host-type efs-case-insensitive-host-types)
|
|
|
9983 (string-equal (downcase f-user)
|
|
|
9984 (downcase (nth 1 t-parsed)))
|
|
|
9985 (string-equal f-user (nth 1 t-parsed))))
|
|
|
9986 ;; Can run a RENAME command on the server.
|
|
|
9987 (efs-rename-on-remote
|
|
|
9988 f-host f-user filename newname f-path (nth 2 t-parsed)
|
|
|
9989 msg nowait
|
|
|
9990 (efs-cont (result line cont-lines) (f-host
|
|
|
9991 filename
|
|
|
9992 newname
|
|
|
9993 ok-if-already-exists
|
|
|
9994 msg cont nowait)
|
|
|
9995 (if result
|
|
|
9996 (progn
|
|
|
9997 (efs-set-host-property f-host 'rnfr-failed t)
|
|
|
9998 (efs-rename-file-internal
|
|
|
9999 filename newname ok-if-already-exists msg cont
|
|
|
10000 (if (eq nowait t) 1 nowait)))
|
|
|
10001 (if cont
|
|
|
10002 (efs-call-cont cont result line cont-lines)))))
|
|
|
10003 ;; remote to remote
|
|
|
10004 (efs-rename-from-remote filename f-parsed newname t-parsed
|
|
|
10005 msg cont nowait)))
|
|
|
10006 ;; local to remote
|
|
|
10007 (efs-rename-local-to-remote
|
|
|
10008 filename newname t-parsed msg cont nowait)))))))
|
|
|
10009
|
|
|
10010 (defun efs-rename-file (filename newname &optional ok-if-already-exists nowait)
|
|
|
10011 ;; Does file renaming for remote files.
|
|
|
10012 (efs-rename-file-internal filename newname ok-if-already-exists
|
|
|
10013 nil nil nowait))
|
|
|
10014
|
|
|
10015 ;;;; ------------------------------------------------------------
|
|
|
10016 ;;;; Making symbolic and hard links.
|
|
|
10017 ;;;; ------------------------------------------------------------
|
|
|
10018
|
|
|
10019 ;;; These functions require that the remote FTP server understand
|
|
|
10020 ;;; SITE EXEC and that ln is in its the ftp-exec path.
|
|
|
10021
|
|
|
10022 (defun efs-try-ln (host user cont nowait)
|
|
|
10023 ;; Do some preemptive testing to see if exec ln works
|
|
|
10024 (if (efs-get-host-property host 'exec-failed)
|
|
|
10025 (signal 'ftp-error (list "Unable to exec ln on host" host)))
|
|
|
10026 (let ((exec-ln (efs-get-host-property host 'exec-ln)))
|
|
|
10027 (cond
|
|
|
10028 ((eq exec-ln 'failed)
|
|
|
10029 (signal 'ftp-error (list "ln is not in FTP exec path on host" host)))
|
|
|
10030 ((eq exec-ln 'works)
|
|
|
10031 (efs-call-cont cont))
|
|
|
10032 (t
|
|
|
10033 (message "Checking for ln executable on %s..." host)
|
|
|
10034 (efs-send-cmd
|
|
|
10035 host user '(quote site exec "ln / /")
|
|
|
10036 nil nil
|
|
|
10037 (efs-cont (result line cont-lines) (host user cont)
|
|
|
10038 (if result
|
|
|
10039 (progn
|
|
|
10040 (efs-set-host-property host 'exec-failed t)
|
|
|
10041 (efs-error host user (format "exec: %s" line)))
|
|
|
10042 ;; Look for an error message
|
|
|
10043 (if (efs-save-match-data
|
|
|
10044 (string-match "\n200-" cont-lines))
|
|
|
10045 (progn
|
|
|
10046 (efs-set-host-property host 'exec-ln 'works)
|
|
|
10047 (efs-call-cont cont))
|
|
|
10048 (efs-set-host-property host 'exec-ln 'failed)
|
|
|
10049 (efs-error host user
|
|
|
10050 (format "ln not in FTP exec path on host %s" host)))))
|
|
|
10051 nowait)))))
|
|
|
10052
|
|
|
10053 (defun efs-make-symbolic-link-internal
|
|
|
10054 (target linkname &optional ok-if-already-exists cont nowait)
|
|
|
10055 ;; Makes remote symbolic links. Assumes that linkname is already expanded.
|
|
|
10056 (let* ((parsed (efs-ftp-path linkname))
|
|
|
10057 (host (car parsed))
|
|
|
10058 (user (nth 1 parsed))
|
|
|
10059 (linkpath (nth 2 parsed))
|
|
|
10060 (abbr (efs-relativize-filename linkname
|
|
|
10061 (file-name-directory target) target))
|
|
|
10062 (tparsed (efs-ftp-path target))
|
|
|
10063 (com-target target)
|
|
|
10064 cmd-string)
|
|
|
10065 (if (null (file-directory-p
|
|
|
10066 (file-name-directory linkname)))
|
|
|
10067 (if cont
|
|
|
10068 (efs-call-cont cont 'failed
|
|
|
10069 (format "no such file or directory, %s" linkname)
|
|
|
10070 "")
|
|
|
10071 (signal 'file-error (list "no such file or directory" linkname)))
|
|
|
10072 (if (or (not ok-if-already-exists)
|
|
|
10073 (numberp ok-if-already-exists))
|
|
|
10074 (efs-barf-or-query-if-file-exists
|
|
|
10075 linkname "make symbolic link" (numberp ok-if-already-exists)))
|
|
|
10076 ;; Do this after above, so that hopefully the host type is sorted out
|
|
|
10077 ;; by now.
|
|
|
10078 (let ((host-type (efs-host-type host)))
|
|
|
10079 (if (or (not (memq host-type efs-unix-host-types))
|
|
|
10080 (memq host-type efs-dumb-host-types)
|
|
|
10081 (efs-get-host-property host 'exec-failed))
|
|
|
10082 (error "Unable to make symbolic links on %s." host)))
|
|
|
10083 ;; Be careful not to spoil relative links, or symlinks to other
|
|
|
10084 ;; machines, which maybe symlink-fix.el can sort out.
|
|
|
10085 (if (and tparsed
|
|
|
10086 (string-equal (downcase (car tparsed)) (downcase host))
|
|
|
10087 (string-equal (nth 1 tparsed) user))
|
|
|
10088 (setq com-target (nth 2 tparsed)))
|
|
|
10089 ;; symlinks only work for unix, so don't need to
|
|
|
10090 ;; convert pathnames. What about VOS?
|
|
|
10091 (setq cmd-string (concat "ln -sf " com-target " " linkpath))
|
|
|
10092 (efs-try-ln
|
|
|
10093 host user
|
|
|
10094 (efs-cont () (host user cmd-string target linkname com-target
|
|
|
10095 abbr cont nowait)
|
|
|
10096 (efs-send-cmd
|
|
|
10097 host user (list 'quote 'site 'exec cmd-string)
|
|
|
10098 (format "Symlinking %s to %s" target abbr)
|
|
|
10099 nil
|
|
|
10100 (efs-cont (result line cont-lines) (host user com-target linkname
|
|
|
10101 cont)
|
|
|
10102 (if result
|
|
|
10103 (progn
|
|
|
10104 (efs-set-host-property host 'exec-failed t)
|
|
|
10105 (efs-error host user (format "exec: %s" line)))
|
|
|
10106 (efs-save-match-data
|
|
|
10107 (if (string-match "\n200-\\([^\n]*\\)" cont-lines)
|
|
|
10108 (let ((err (substring cont-lines (match-beginning 1)
|
|
|
10109 (match-end 1))))
|
|
|
10110 (if cont
|
|
|
10111 (efs-call-cont cont 'failed err cont-lines)
|
|
|
10112 (efs-error host user err)))
|
|
|
10113 (efs-add-file-entry nil linkname com-target nil user)
|
|
|
10114 (if cont (efs-call-cont cont nil line cont-lines))))))
|
|
|
10115 nowait))
|
|
|
10116 nowait))))
|
|
|
10117
|
|
|
10118 (defun efs-make-symbolic-link (target linkname &optional ok-if-already-exists)
|
|
|
10119 ;; efs version of make-symbolic-link
|
|
|
10120 (let* ((linkname (expand-file-name linkname))
|
|
|
10121 (parsed (efs-ftp-path linkname)))
|
|
|
10122 (if parsed
|
|
|
10123 (efs-make-symbolic-link-internal target linkname ok-if-already-exists)
|
|
|
10124 ;; Handler will match on either target or linkname. We are only
|
|
|
10125 ;; interested in the linkname.
|
|
|
10126 (let ((file-name-handler-alist (efs-file-name-handler-alist-sans-fn
|
|
|
10127 'efs-file-handler-function)))
|
|
|
10128 (make-symbolic-link target linkname ok-if-already-exists)))))
|
|
|
10129
|
|
|
10130 (defun efs-add-name-to-file-internal
|
|
|
10131 (file newname &optional ok-if-already-exists cont nowait)
|
|
|
10132 ;; Makes remote symbolic links. Assumes that linkname is already expanded.
|
|
|
10133 (let* ((parsed (efs-ftp-path file))
|
|
|
10134 (host (car parsed))
|
|
|
10135 (user (nth 1 parsed))
|
|
|
10136 (path (nth 2 parsed))
|
|
|
10137 (nparsed (efs-ftp-path newname))
|
|
|
10138 (nhost (car nparsed))
|
|
|
10139 (nuser (nth 1 nparsed))
|
|
|
10140 (npath (nth 2 nparsed))
|
|
|
10141 (abbr (efs-relativize-filename newname
|
|
|
10142 (file-name-directory file)))
|
|
|
10143 (ent (efs-get-file-entry file))
|
|
|
10144 cmd-string)
|
|
|
10145 (or (and (string-equal (downcase host) (downcase nhost))
|
|
|
10146 (string-equal user nuser))
|
|
|
10147 (error "Cannot create hard links between different host user pairs."))
|
|
|
10148 (if (or (null ent) (stringp (car ent))
|
|
|
10149 (not (file-directory-p
|
|
|
10150 (file-name-directory newname))))
|
|
|
10151 (if cont
|
|
|
10152 (efs-call-cont cont 'failed
|
|
|
10153 (format "no such file or directory, %s %s"
|
|
|
10154 file newname) "")
|
|
|
10155 (signal 'file-error
|
|
|
10156 (list "no such file or directory"
|
|
|
10157 file newname)))
|
|
|
10158 (if (or (not ok-if-already-exists)
|
|
|
10159 (numberp ok-if-already-exists))
|
|
|
10160 (efs-barf-or-query-if-file-exists
|
|
|
10161 newname "make hard link" (numberp ok-if-already-exists)))
|
|
|
10162 ;; Do this last, so that hopefully the host type is known.
|
|
|
10163 (let ((host-type (efs-host-type host)))
|
|
|
10164 (if (or (not (memq host-type efs-unix-host-types))
|
|
|
10165 (memq host-type efs-dumb-host-types)
|
|
|
10166 (efs-get-host-property host 'exec-failed))
|
|
|
10167 (error "Unable to make hard links on %s." host)))
|
|
|
10168 (setq cmd-string (concat "ln -f " path " " npath))
|
|
|
10169 (efs-try-ln
|
|
|
10170 host user
|
|
|
10171 (efs-cont () (host user cmd-string file newname abbr cont nowait)
|
|
|
10172 (efs-send-cmd
|
|
|
10173 host user (list 'quote 'site 'exec cmd-string)
|
|
|
10174 (format "Adding to %s name %s" file abbr)
|
|
|
10175 nil
|
|
|
10176 (efs-cont (result line cont-lines) (host user file newname cont)
|
|
|
10177 (if result
|
|
|
10178 (progn
|
|
|
10179 (efs-set-host-property host 'exec-failed t)
|
|
|
10180 (efs-error host user (format "exec: %s" line)))
|
|
|
10181 (efs-save-match-data
|
|
|
10182 (if (string-match "\n200-\\([^\n]*\\)" cont-lines)
|
|
|
10183 (let ((err (substring cont-lines (match-beginning 1)
|
|
|
10184 (match-end 1))))
|
|
|
10185 (if cont
|
|
|
10186 (efs-call-cont cont 'failed err cont-lines)
|
|
|
10187 (efs-error host user err)))
|
|
|
10188 (let ((ent (efs-get-file-entry file)))
|
|
|
10189 (if ent
|
|
|
10190 (let ((nlinks (nthcdr 4 ent))
|
|
|
10191 new-nlinks)
|
|
|
10192 (and (integerp (car nlinks))
|
|
|
10193 (setq new-nlinks (1+ (car nlinks)))
|
|
|
10194 (setcar nlinks new-nlinks))
|
|
|
10195 (apply 'efs-add-file-entry nil newname ent)
|
|
|
10196 (if cont (efs-call-cont cont nil line cont-lines)))
|
|
|
10197 (let ((tbl (efs-get-files-hashtable-entry
|
|
|
10198 (file-name-directory
|
|
|
10199 (directory-file-name newname)))))
|
|
|
10200 (if tbl
|
|
|
10201 (efs-ls
|
|
|
10202 newname
|
|
|
10203 (concat (efs-ls-guess-switches) "d") t t nil
|
|
|
10204 nowait
|
|
|
10205 (efs-cont (listing) (newname cont line cont-lines)
|
|
|
10206 (efs-update-file-info
|
|
|
10207 newname efs-data-buffer-name)
|
|
|
10208 (if cont
|
|
|
10209 (efs-call-cont cont nil line cont-lines))))
|
|
|
10210 (if cont
|
|
|
10211 (efs-call-cont cont nil line cont-lines))))))))))
|
|
|
10212 nowait))
|
|
|
10213 nowait))))
|
|
|
10214
|
|
|
10215 (defun efs-add-name-to-file (file newname &optional ok-if-already-exists)
|
|
|
10216 ;; efs version of add-name-to-file
|
|
|
10217 (efs-add-name-to-file-internal file newname ok-if-already-exists))
|
|
|
10218
|
|
|
10219
|
|
|
10220 ;;;; ==============================================================
|
|
|
10221 ;;;; >9
|
|
|
10222 ;;;; Multiple Host Type Support.
|
|
|
10223 ;;;; The initial host type guessing is done in the PWD code below.
|
|
|
10224 ;;;; If necessary, further guessing is done in the listing parser.
|
|
|
10225 ;;;; ==============================================================
|
|
|
10226
|
|
|
10227
|
|
|
10228 ;;;; --------------------------------------------------------------
|
|
|
10229 ;;;; Functions for setting and retrieving host types.
|
|
|
10230 ;;;; --------------------------------------------------------------
|
|
|
10231
|
|
|
10232 (defun efs-add-host (type host)
|
|
|
10233 "Sets the TYPE of the remote host HOST.
|
|
|
10234 The host type is read with completion so this can be used to obtain a
|
|
|
10235 list of supported host types. HOST must be a string, giving the name of
|
|
|
10236 the host, exactly as given in file names. Setting the host type with
|
|
|
10237 this function is preferable to setting the efs-TYPE-host-regexp, as look up
|
|
|
10238 will be faster. Returns TYPE."
|
|
|
10239 ;; Since internet host names are always case-insensitive, we will cache
|
|
|
10240 ;; them in lower case.
|
|
|
10241 (interactive
|
|
|
10242 (list
|
|
|
10243 (intern
|
|
|
10244 (completing-read "Host type: "
|
|
|
10245 (mapcar
|
|
|
10246 (function (lambda (elt)
|
|
|
10247 (list (symbol-name (car elt)))))
|
|
|
10248 efs-host-type-alist)
|
|
|
10249 nil t))
|
|
|
10250 (read-string "Host: "
|
|
|
10251 (let ((name (or (buffer-file-name)
|
|
|
10252 (and (eq major-mode 'dired-mode)
|
|
|
10253 dired-directory))))
|
|
|
10254 (and name (car (efs-ftp-path name)))))))
|
|
|
10255 (setq host (downcase host))
|
|
|
10256 (efs-set-host-property host 'host-type type)
|
|
|
10257 (prog1
|
|
|
10258 (setq efs-host-cache host
|
|
|
10259 efs-host-type-cache type)
|
|
|
10260 (efs-set-process-host-type host)))
|
|
|
10261
|
|
|
10262 (defun efs-set-process-host-type (host &optional user)
|
|
|
10263 ;; Sets the value of efs-process-host-type so that it is shown
|
|
|
10264 ;; on the mode-line.
|
|
|
10265 (let ((buff-list (buffer-list)))
|
|
|
10266 (save-excursion
|
|
|
10267 (while buff-list
|
|
|
10268 (set-buffer (car buff-list))
|
|
|
10269 (if (equal efs-process-host host)
|
|
|
10270 (setq efs-process-host-type (concat " " (symbol-name
|
|
|
10271 (efs-host-type host))))
|
|
|
10272 (and efs-show-host-type-in-dired
|
|
|
10273 (eq major-mode 'dired-mode)
|
|
|
10274 efs-dired-host-type
|
|
|
10275 (string-equal (downcase
|
|
|
10276 (car (efs-ftp-path default-directory)))
|
|
|
10277 (downcase host))
|
|
|
10278 (if user
|
|
|
10279 (setq efs-dired-listing-type-string
|
|
|
10280 (concat
|
|
|
10281 " "
|
|
|
10282 (symbol-name (efs-listing-type host user))))
|
|
|
10283 (or efs-dired-listing-type-string
|
|
|
10284 (setq efs-dired-listing-type-string
|
|
|
10285 (concat " " (symbol-name (efs-host-type host))))))))
|
|
|
10286 (setq buff-list (cdr buff-list))))))
|
|
|
10287
|
|
|
10288 ;;;; ----------------------------------------------------------------
|
|
|
10289 ;;;; Functions for setting and retrieving listings types.
|
|
|
10290 ;;;; ----------------------------------------------------------------
|
|
|
10291
|
|
|
10292 ;;; listing types??
|
|
|
10293 ;;; These are distinguished from host types, in case some OS's have two
|
|
|
10294 ;;; breeds of listings. e.g. Unix descriptive listings.
|
|
|
10295 ;;; We also use this to support the myriad of DOS ftp servers.
|
|
|
10296
|
|
|
10297
|
|
|
10298 (defun efs-listing-type (host user)
|
|
|
10299 "Returns the type of listing used on HOST by USER.
|
|
|
10300 If there is no entry for a specialized listing, returns the host type."
|
|
|
10301 (or
|
|
|
10302 (efs-get-host-user-property host user 'listing-type)
|
|
|
10303 (efs-host-type host user)))
|
|
|
10304
|
|
|
10305 (defun efs-add-listing-type (type host user)
|
|
|
10306 "Interactively adds the specialized listing type TYPE for HOST and USER
|
|
|
10307 to the listing type cache."
|
|
|
10308 (interactive
|
|
|
10309 (let ((name (or (buffer-file-name)
|
|
|
10310 (and (eq major-mode 'dired-mode)
|
|
|
10311 dired-directory))))
|
|
|
10312 (list
|
|
|
10313 (intern
|
|
|
10314 (completing-read "Listing type: "
|
|
|
10315 (mapcar
|
|
|
10316 (function (lambda (elt)
|
|
|
10317 (list (symbol-name elt))))
|
|
|
10318 efs-listing-types)
|
|
|
10319 nil t))
|
|
|
10320 (read-string "Host: "
|
|
|
10321 (and name (car (efs-ftp-path name))))
|
|
|
10322 (read-string "User: "
|
|
|
10323 (and name (nth 1 (efs-ftp-path name)))))))
|
|
|
10324 (efs-set-host-user-property host user 'listing-type type)
|
|
|
10325 (efs-set-process-host-type host user))
|
|
|
10326
|
|
|
10327 ;;;; --------------------------------------------------------------
|
|
|
10328 ;;;; Auotomagic bug reporting for unrecognized host types.
|
|
|
10329 ;;;; --------------------------------------------------------------
|
|
|
10330
|
|
|
10331 (defun efs-scream-and-yell-1 (host user)
|
|
|
10332 ;; Internal for efs-scream-and-yell.
|
|
|
10333 (with-output-to-temp-buffer "*Help*"
|
|
|
10334 (princ
|
|
|
10335 (format
|
|
|
10336 "efs is unable to identify the remote host type of %s.
|
|
|
10337
|
|
|
10338 Please report this as a bug. It would be very helpful
|
|
|
10339 if your bug report contained at least the PWD command
|
|
|
10340 within the *ftp %s@%s* buffer.
|
|
|
10341 If you know them, also send the operating system
|
|
|
10342 and ftp server types of the remote host." host user host)))
|
|
|
10343 (if (y-or-n-p "Would you like to submit a bug report now? ")
|
|
|
10344 (efs-report-bug host user
|
|
|
10345 "Bug occurred during efs-guess-host-type." t)))
|
|
|
10346
|
|
|
10347 (defun efs-scream-and-yell (host user)
|
|
|
10348 ;; Advertises that something has gone wrong in identifying the host type.
|
|
|
10349 (if (eq (selected-window) (minibuffer-window))
|
|
|
10350 (efs-abort-recursive-edit-and-then 'efs-scream-and-yell-1 host user)
|
|
|
10351 (efs-scream-and-yell-1 host user)
|
|
|
10352 (error "Unable to identify remote host type")))
|
|
|
10353
|
|
|
10354 ;;;; --------------------------------------------------------
|
|
|
10355 ;;;; Guess at the host type using PWD syntax.
|
|
|
10356 ;;;; --------------------------------------------------------
|
|
|
10357
|
|
|
10358 ;; host-type path templates. These should match a pwd performed
|
|
|
10359 ;; as the first command after connecting. They should be as tight
|
|
|
10360 ;; as possible
|
|
|
10361
|
|
|
10362 (defconst efs-unix-path-template "^/")
|
|
|
10363 (defconst efs-apollo-unix-path-template "^//")
|
|
|
10364 (defconst efs-cms-path-template
|
|
|
10365 (concat
|
|
|
10366 "^[-A-Z0-9$*][-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?"
|
|
|
10367 "[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?\\.[0-9][0-9][0-9A-Z]$\\|"
|
|
|
10368 ;; For the SFS version of CMS
|
|
|
10369 "^[-A-Z0-9]+:[-A-Z0-9$*]+\\.$"))
|
|
|
10370
|
|
|
10371 (defconst efs-mvs-path-template "^'?[A-Z][0-9][0-9]?[0-9]?[0-9]?[0-9]?\\.'?")
|
|
|
10372
|
|
|
10373 (defconst efs-guardian-path-template
|
|
|
10374 (concat
|
|
|
10375 "^\\("
|
|
|
10376 "\\\\[A-Z0-9][A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?\\."
|
|
|
10377 "\\)?"
|
|
|
10378 "\\$[A-Z0-9][A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?\\."
|
|
|
10379 "[A-Z][A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?$"))
|
|
|
10380 ;; guardian and cms are very close to overlapping (they don't). Be careful.
|
|
|
10381 (defconst efs-vms-path-template
|
|
|
10382 "^[-A-Z0-9_$]+:\\[[-A-Z0-9_$]+\\(\\.[-A-Z0-9_$]+\\)*\\]$")
|
|
|
10383 (defconst efs-mts-path-template
|
|
|
10384 "^[A-Z0-9._][A-Z0-9._][A-Z0-9._][A-Z0-9._]:$")
|
|
|
10385 (defconst efs-ms-unix-path-template "^[A-Za-z0-9]:/")
|
|
|
10386
|
|
|
10387 ;; Following two are for TI lisp machines. Note that lisp machines
|
|
|
10388 ;; do not have a default directory, but only a default pathname against
|
|
|
10389 ;; which relative pathnames are merged (Jamie tells me).
|
|
|
10390 (defconst efs-ti-explorer-pwd-line-template
|
|
|
10391 (let* ((excluded-chars ":;<>.#\n\r\t\\/a-z ")
|
|
|
10392 (token (concat "[^" excluded-chars "]+")))
|
|
|
10393 (concat "^250 "
|
|
|
10394 token ": " ; host name
|
|
|
10395 token "\\(\\." token "\\)*; " ; directory
|
|
|
10396 "\\(\\*.\\*\\|\\*\\)#\\(\\*\\|>\\)" ; name, ext, version
|
|
|
10397 "$"))) ; "*.*#*" or "*.*#>" or "*#*" or "*#>" or "#*" ...
|
|
|
10398 (defconst efs-ti-twenex-path-template
|
|
|
10399 (let* ((excluded-chars ":;<>.#\n\r\t\\/a-z ")
|
|
|
10400 (token (concat "[^" excluded-chars "]+")))
|
|
|
10401 (concat "^"
|
|
|
10402 token ":" ; host name
|
|
|
10403 "<\\(" token "\\)?\\(\\." token "\\)*>" ; directory
|
|
|
10404 "\\(\\*.\\*\\|\\*\\)" ; name and extension
|
|
|
10405 "$")))
|
|
|
10406
|
|
|
10407 (defconst efs-tops-20-path-template
|
|
|
10408 "^[-A-Z0-9_$]+:<[-A-Z0-9_$]\\(.[-A-Z0-9_$]+\\)*>$")
|
|
|
10409 (defconst efs-pc-path-template
|
|
|
10410 "^[a-zA-Z0-9]:\\\\\\([-_+=a-zA-Z0-9.]+\\\\\\)*[-_+=a-zA-Z0-9.]*$")
|
|
|
10411 (defconst efs-mpe-path-template
|
|
|
10412 (let ((token (concat "[A-Z][A-Z0-9]?[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?"
|
|
|
10413 "[A-Z0-9]?[A-Z0-9]?[A-Z0-9]?")))
|
|
|
10414 (concat
|
|
|
10415 ;; optional session name
|
|
|
10416 "^\\(" token "\\)?,"
|
|
|
10417 ;; username
|
|
|
10418 token "."
|
|
|
10419 ;; account
|
|
|
10420 token ","
|
|
|
10421 ;; group
|
|
|
10422 token "$")))
|
|
|
10423 (defconst efs-vos-path-template
|
|
|
10424 (let ((token "[][@\\^`{}|~\"$+,---./:_a-zA-Z0-9]+"))
|
|
|
10425 (concat
|
|
|
10426 "%" token ; host
|
|
|
10427 "#" token ; disk
|
|
|
10428 "\\(>" token "\\)+" ; directories
|
|
|
10429 )))
|
|
|
10430 (defconst efs-netware-path-template "^[-A-Z0-9_][-A-Z0-9_/]*:/")
|
|
|
10431 ;; Sometimes netware doesn't return a device to a PWD. Then it will be
|
|
|
10432 ;; recognized by the listing parser.
|
|
|
10433
|
|
|
10434 (defconst efs-nos-ve-path-template "^:[A-Z0-9]")
|
|
|
10435 ;; Matches the path for NOS/VE
|
|
|
10436
|
|
|
10437 (defconst efs-mvs-pwd-line-template
|
|
|
10438 ;; Not sure how the PWD parser will do with empty strings, so treate
|
|
|
10439 ;; this as a line regexp.
|
|
|
10440 "^257 \\([Nn]o prefix defined\\|\"\" is working directory\\)")
|
|
|
10441 (defconst efs-cms-pwd-line-template
|
|
|
10442 "^450 No current working directory defined$")
|
|
|
10443 (defconst efs-tops-20-pwd-line-template
|
|
|
10444 "^500 I never heard of the \\(XPWD\\|PWD\\) command\\. Try HELP\\.$")
|
|
|
10445 (defconst efs-dos:ftp-pwd-line-template
|
|
|
10446 "^250 Current working directory is +")
|
|
|
10447 (defconst efs-coke-pwd-line-template "^257 Current balance \\$[0-9]")
|
|
|
10448
|
|
|
10449 (defconst efs-super-dumb-unix-tilde-regexp
|
|
|
10450 "^550 /.*: No such file or directory\\.?$")
|
|
|
10451 (defconst efs-cms-knet-tilde-regexp
|
|
|
10452 "^501 Invalid CMS fileid: ~$")
|
|
|
10453
|
|
|
10454
|
|
|
10455 ;; It might be nice to message users about the host type identified,
|
|
|
10456 ;; but there is so much other messaging going on, it would not be
|
|
|
10457 ;; seen. No point in slowing things down just so users can read
|
|
|
10458 ;; a host type message.
|
|
|
10459
|
|
|
10460 (defun efs-guess-host-type (host user)
|
|
|
10461 "Guess the host type of HOST.
|
|
|
10462 Does a PWD and examines the directory syntax. The PWD is then cached for use
|
|
|
10463 in file name expansion."
|
|
|
10464 (let ((host-type (efs-host-type host))
|
|
|
10465 (key (concat host "/" user "/~"))
|
|
|
10466 syst)
|
|
|
10467 (efs-save-match-data
|
|
|
10468 (if (eq host-type 'unknown)
|
|
|
10469 ;; Note that efs-host-type returns unknown as the default.
|
|
|
10470 ;; Since we don't yet know the host-type, we use the default
|
|
|
10471 ;; version of efs-send-pwd. We compensate if necessary
|
|
|
10472 ;; by looking at the entire line of output.
|
|
|
10473 (let* ((result (efs-send-pwd nil host user))
|
|
|
10474 (dir (car result))
|
|
|
10475 (line (cdr result)))
|
|
|
10476 (cond
|
|
|
10477
|
|
|
10478 ;; First sift through process lines to see if we recognize
|
|
|
10479 ;; any pwd errors, or full line messages.
|
|
|
10480
|
|
|
10481 ;; CMS
|
|
|
10482 ((string-match efs-cms-pwd-line-template line)
|
|
|
10483 (setq host-type (efs-add-host 'cms host)
|
|
|
10484 dir (concat "/" (if (> (length user) 8)
|
|
|
10485 (substring user 0 8)
|
|
|
10486 user)
|
|
|
10487 ".191"))
|
|
|
10488 (message
|
|
|
10489 "Unable to determine a \"home\" CMS minidisk. Assuming %s"
|
|
|
10490 dir)
|
|
|
10491 (sit-for 1))
|
|
|
10492
|
|
|
10493 ;; TOPS-20
|
|
|
10494 ((string-match efs-tops-20-pwd-line-template line)
|
|
|
10495 (setq host-type (efs-add-host 'tops-20 host)
|
|
|
10496 dir (car (efs-send-pwd 'tops-20 host user))))
|
|
|
10497
|
|
|
10498 ;; TI-EXPLORER lisp machine. pwd works here, but the output
|
|
|
10499 ;; needs to be specially parsed since spaces separate
|
|
|
10500 ;; hostnames from dirs from filenames.
|
|
|
10501 ((string-match efs-ti-explorer-pwd-line-template line)
|
|
|
10502 (setq host-type (efs-add-host 'ti-explorer host)
|
|
|
10503 dir (substring line 4)))
|
|
|
10504
|
|
|
10505 ;; FTP Software's DOS Server
|
|
|
10506 ((string-match efs-dos:ftp-pwd-line-template line)
|
|
|
10507 (setq host-type (efs-add-host 'dos host)
|
|
|
10508 dir (substring line (match-end 0)))
|
|
|
10509 (efs-add-listing-type 'dos:ftp host user))
|
|
|
10510
|
|
|
10511 ;; MVS
|
|
|
10512 ((string-match efs-mvs-pwd-line-template line)
|
|
|
10513 (setq host-type (efs-add-host 'mvs host)
|
|
|
10514 dir "")) ; "" will convert to /, which is always
|
|
|
10515 ; the mvs home dir.
|
|
|
10516
|
|
|
10517 ;; COKE
|
|
|
10518 ((string-match efs-coke-pwd-line-template line)
|
|
|
10519 (setq host-type (efs-add-host 'coke host)
|
|
|
10520 dir "/"))
|
|
|
10521
|
|
|
10522 ;; Try to get tilde.
|
|
|
10523 ((null dir)
|
|
|
10524 (let ((tilde (nth 1 (efs-send-cmd
|
|
|
10525 host user (list 'get "~" "/dev/null")))))
|
|
|
10526 (cond
|
|
|
10527 ;; super dumb unix
|
|
|
10528 ((string-match efs-super-dumb-unix-tilde-regexp tilde)
|
|
|
10529 (setq dir (car (efs-send-pwd 'super-dumb-unix host user))
|
|
|
10530 host-type (efs-add-host 'super-dumb-unix host)))
|
|
|
10531
|
|
|
10532 ;; Try for cms-knet
|
|
|
10533 ((string-match efs-cms-knet-tilde-regexp tilde)
|
|
|
10534 (setq dir (car (efs-send-pwd 'cms-knet host user))
|
|
|
10535 host-type (efs-add-host 'cms-knet host)))
|
|
|
10536
|
|
|
10537 ;; We don't know. Scream and yell.
|
|
|
10538 (efs-scream-and-yell host user))))
|
|
|
10539
|
|
|
10540 ;; Now look at dir to determine host type
|
|
|
10541
|
|
|
10542 ;; try for UN*X-y type stuff
|
|
|
10543 ((string-match efs-unix-path-template dir)
|
|
|
10544 (if
|
|
|
10545 ;; Check for apollo, so we know not to short-circuit //.
|
|
|
10546 (string-match efs-apollo-unix-path-template dir)
|
|
|
10547 (progn
|
|
|
10548 (setq host-type (efs-add-host 'apollo-unix host))
|
|
|
10549 (efs-add-listing-type 'unix:unknown host user))
|
|
|
10550 ;; could be ka9q, dos-distinct, plus any of the unix breeds,
|
|
|
10551 ;; except apollo.
|
|
|
10552 (if (setq syst (efs-get-syst host user))
|
|
|
10553 (let ((case-fold-search t))
|
|
|
10554 (cond
|
|
|
10555 ((string-match "\\bNetware\\b" syst)
|
|
|
10556 (setq host-type (efs-add-host 'netware host)))
|
|
|
10557 ((string-match "^Plan 9" syst)
|
|
|
10558 (setq host-type (efs-add-host 'plan9 host)))
|
|
|
10559 ((string-match "^UNIX" syst)
|
|
|
10560 (setq host-type (efs-add-host 'unix host))
|
|
|
10561 (efs-add-listing-type 'unix:unknown host user)))))))
|
|
|
10562
|
|
|
10563 ;; try for VMS
|
|
|
10564 ((string-match efs-vms-path-template dir)
|
|
|
10565 (setq host-type (efs-add-host 'vms host)))
|
|
|
10566
|
|
|
10567 ;; try for MTS
|
|
|
10568 ((string-match efs-mts-path-template dir)
|
|
|
10569 (setq host-type (efs-add-host 'mts host)))
|
|
|
10570
|
|
|
10571 ;; try for CMS
|
|
|
10572 ((string-match efs-cms-path-template dir)
|
|
|
10573 (setq host-type (efs-add-host 'cms host)))
|
|
|
10574
|
|
|
10575 ;; try for Tandem's guardian OS
|
|
|
10576 ((string-match efs-guardian-path-template dir)
|
|
|
10577 (setq host-type (efs-add-host 'guardian host)))
|
|
|
10578
|
|
|
10579 ;; Try for TOPS-20. pwd doesn't usually work for tops-20
|
|
|
10580 ;; But who knows???
|
|
|
10581 ((string-match efs-tops-20-path-template dir)
|
|
|
10582 (setq host-type (efs-add-host 'tops-20 host)))
|
|
|
10583
|
|
|
10584 ;; Try for DOS or OS/2.
|
|
|
10585 ((string-match efs-pc-path-template dir)
|
|
|
10586 (let ((syst (efs-get-syst host user))
|
|
|
10587 (case-fold-search t))
|
|
|
10588 (if (and syst (string-match "^OS/2 " syst))
|
|
|
10589 (setq host-type (efs-add-host 'os2 host))
|
|
|
10590 (setq host-type (efs-add-host 'dos host)))))
|
|
|
10591
|
|
|
10592 ;; try for TI-TWENEX lisp machine
|
|
|
10593 ((string-match efs-ti-twenex-path-template dir)
|
|
|
10594 (setq host-type (efs-add-host 'ti-twenex host)))
|
|
|
10595
|
|
|
10596 ;; try for MPE
|
|
|
10597 ((string-match efs-mpe-path-template dir)
|
|
|
10598 (setq host-type (efs-add-host 'mpe host)))
|
|
|
10599
|
|
|
10600 ;; try for VOS
|
|
|
10601 ((string-match efs-vos-path-template dir)
|
|
|
10602 (setq host-type (efs-add-host 'vos host)))
|
|
|
10603
|
|
|
10604 ;; try for the microsoft server in unix mode
|
|
|
10605 ((string-match efs-ms-unix-path-template dir)
|
|
|
10606 (setq host-type (efs-add-host 'ms-unix host)))
|
|
|
10607
|
|
|
10608 ;; Netware?
|
|
|
10609 ((string-match efs-netware-path-template dir)
|
|
|
10610 (setq host-type (efs-add-host 'netware host)))
|
|
|
10611
|
|
|
10612 ;; Try for MVS
|
|
|
10613 ((string-match efs-mvs-path-template dir)
|
|
|
10614 (if (string-match "^'.+'$" dir)
|
|
|
10615 ;; broken MVS PWD quoting
|
|
|
10616 (setq dir (substring dir 1 -1)))
|
|
|
10617 (setq host-type (efs-add-host 'mvs host)))
|
|
|
10618
|
|
|
10619 ;; Try for NOS/VE
|
|
|
10620 ((string-match efs-nos-ve-path-template dir)
|
|
|
10621 (setq host-type (efs-add-host 'nos-ve host)))
|
|
|
10622
|
|
|
10623 ;; We don't know. Scream and yell.
|
|
|
10624 (t
|
|
|
10625 (efs-scream-and-yell host user)))
|
|
|
10626
|
|
|
10627 ;; Now that we have done a pwd, might as well put it in
|
|
|
10628 ;; the expand-dir hashtable.
|
|
|
10629 (if dir
|
|
|
10630 (efs-put-hash-entry
|
|
|
10631 key
|
|
|
10632 (efs-internal-directory-file-name
|
|
|
10633 (efs-fix-path host-type dir 'reverse))
|
|
|
10634 efs-expand-dir-hashtable
|
|
|
10635 (memq host-type efs-case-insensitive-host-types))))
|
|
|
10636
|
|
|
10637 ;; host-type has been identified by regexp, set the mode-line.
|
|
|
10638 (efs-set-process-host-type host user)
|
|
|
10639
|
|
|
10640 ;; Some special cases, where we need to store the cwd on login.
|
|
|
10641 (if (not (efs-hash-entry-exists-p
|
|
|
10642 key efs-expand-dir-hashtable))
|
|
|
10643 (cond
|
|
|
10644 ;; CMS: We will be doing cd's, so we'd better make sure that
|
|
|
10645 ;; we know where home is.
|
|
|
10646 ((eq host-type 'cms)
|
|
|
10647 (let* ((res (efs-send-pwd 'cms host user))
|
|
|
10648 (dir (car res))
|
|
|
10649 (line (cdr res)))
|
|
|
10650 (if (and dir (not (string-match
|
|
|
10651 efs-cms-pwd-line-template line)))
|
|
|
10652 (setq dir (concat "/" dir))
|
|
|
10653 (setq dir (concat "/" (if (> (length user) 8)
|
|
|
10654 (substring user 0 8)
|
|
|
10655 user)
|
|
|
10656 ".191"))
|
|
|
10657 (message
|
|
|
10658 "Unable to determine a \"home\" CMS minidisk. Assuming %s"
|
|
|
10659 dir))
|
|
|
10660 (efs-put-hash-entry
|
|
|
10661 key dir efs-expand-dir-hashtable
|
|
|
10662 (memq 'cms efs-case-insensitive-host-types))))
|
|
|
10663 ;; MVS: pwd doesn't work in the root directory, so we stuff this
|
|
|
10664 ;; into the hashtable manually.
|
|
|
10665 ((eq host-type 'mvs)
|
|
|
10666 (efs-put-hash-entry key "/" efs-expand-dir-hashtable))
|
|
|
10667 ))))))
|
|
|
10668
|
|
|
10669
|
|
|
10670 ;;;; -----------------------------------------------------------
|
|
|
10671 ;;;; efs-autoloads
|
|
|
10672 ;;;; These provide the entry points for the non-unix packages.
|
|
|
10673 ;;;; -----------------------------------------------------------
|
|
|
10674
|
|
|
10675 (efs-autoload 'efs-fix-path vms "efs-vms")
|
|
|
10676 (efs-autoload 'efs-fix-path mts "efs-mts")
|
|
|
10677 (efs-autoload 'efs-fix-path cms "efs-cms")
|
|
|
10678 (efs-autoload 'efs-fix-path ti-explorer "efs-ti-explorer")
|
|
|
10679 (efs-autoload 'efs-fix-path ti-twenex "efs-ti-twenex")
|
|
|
10680 (efs-autoload 'efs-fix-path dos "efs-pc")
|
|
|
10681 (efs-autoload 'efs-fix-path mvs "efs-mvs")
|
|
|
10682 (efs-autoload 'efs-fix-path tops-20 "efs-tops-20")
|
|
|
10683 (efs-autoload 'efs-fix-path mpe "efs-mpe")
|
|
|
10684 (efs-autoload 'efs-fix-path os2 "efs-pc")
|
|
|
10685 (efs-autoload 'efs-fix-path vos "efs-vos")
|
|
|
10686 (efs-autoload 'efs-fix-path ms-unix "efs-ms-unix")
|
|
|
10687 (efs-autoload 'efs-fix-path netware "efs-netware")
|
|
|
10688 (efs-autoload 'efs-fix-path cms-knet "efs-cms-knet")
|
|
|
10689 (efs-autoload 'efs-fix-path guardian "efs-guardian")
|
|
|
10690 (efs-autoload 'efs-fix-path nos-ve "efs-nos-ve")
|
|
|
10691
|
|
|
10692 (efs-autoload 'efs-fix-dir-path vms "efs-vms")
|
|
|
10693 (efs-autoload 'efs-fix-dir-path mts "efs-mts")
|
|
|
10694 (efs-autoload 'efs-fix-dir-path cms "efs-cms")
|
|
|
10695 (efs-autoload 'efs-fix-dir-path ti-explorer "efs-ti-explorer")
|
|
|
10696 (efs-autoload 'efs-fix-dir-path ti-twenex "efs-ti-twenex")
|
|
|
10697 (efs-autoload 'efs-fix-dir-path dos "efs-pc")
|
|
|
10698 (efs-autoload 'efs-fix-dir-path mvs "efs-mvs")
|
|
|
10699 (efs-autoload 'efs-fix-dir-path tops-20 "efs-tops-20")
|
|
|
10700 (efs-autoload 'efs-fix-dir-path mpe "efs-mpe")
|
|
|
10701 (efs-autoload 'efs-fix-dir-path os2 "efs-pc")
|
|
|
10702 (efs-autoload 'efs-fix-dir-path vos "efs-vos")
|
|
|
10703 (efs-autoload 'efs-fix-dir-path hell "efs-hell")
|
|
|
10704 (efs-autoload 'efs-fix-dir-path ms-unix "efs-ms-unix")
|
|
|
10705 (efs-autoload 'efs-fix-dir-path netware "efs-netware")
|
|
|
10706 (efs-autoload 'efs-fix-dir-path plan9 "efs-plan9")
|
|
|
10707 (efs-autoload 'efs-fix-dir-path cms-knet "efs-cms-knet")
|
|
|
10708 (efs-autoload 'efs-fix-dir-path guardian "efs-guardian")
|
|
|
10709 (efs-autoload 'efs-fix-dir-path nos-ve "efs-nos-ve")
|
|
|
10710 (efs-autoload 'efs-fix-dir-path coke "efs-coke")
|
|
|
10711
|
|
|
10712 ;; A few need to autoload a pwd function
|
|
|
10713 (efs-autoload 'efs-send-pwd tops-20 "efs-tops-20")
|
|
|
10714 (efs-autoload 'efs-send-pwd cms-knet "efs-cms-knet")
|
|
|
10715 (efs-autoload 'efs-send-pwd ti-explorer "efs-ti-explorer")
|
|
|
10716 (efs-autoload 'efs-send-pwd hell "efs-hell")
|
|
|
10717 (efs-autoload 'efs-send-pwd mvs "efs-mvs")
|
|
|
10718 (efs-autoload 'efs-send-pwd coke "efs-coke")
|
|
|
10719
|
|
|
10720 ;; A few packages are loaded by the listing parser.
|
|
|
10721 (efs-autoload 'efs-parse-listing ka9q "efs-ka9q")
|
|
|
10722 (efs-autoload 'efs-parse-listing unix:dl "efs-dl")
|
|
|
10723 (efs-autoload 'efs-parse-listing dos-distinct "efs-dos-distinct")
|
|
|
10724 (efs-autoload 'efs-parse-listing hell "efs-hell")
|
|
|
10725 (efs-autoload 'efs-parse-listing netware "efs-netware")
|
|
|
10726
|
|
|
10727 ;; Packages that need to autoload for child-lookup
|
|
|
10728 (efs-autoload 'efs-allow-child-lookup plan9 "efs-plan9")
|
|
|
10729 (efs-autoload 'efs-allow-child-lookup coke "efs-coke")
|
|
|
10730
|
|
|
10731 ;; Packages that need to autoload for file-exists-p and file-directory-p
|
|
|
10732 (efs-autoload 'efs-internal-file-exists-p guardian "efs-guardian")
|
|
|
10733 (efs-autoload 'efs-internal-file-directory-p guardian "efs-guardian")
|
|
|
10734
|
|
|
10735
|
|
|
10736
|
|
|
10737 ;;;; ============================================================
|
|
|
10738 ;;;; >10
|
|
|
10739 ;;;; Attaching onto the appropriate Emacs version
|
|
|
10740 ;;;; ============================================================
|
|
|
10741
|
|
|
10742 ;;;; -------------------------------------------------------------------
|
|
|
10743 ;;;; Connect to various hooks.
|
|
|
10744 ;;;; -------------------------------------------------------------------
|
|
|
10745
|
|
|
10746 (or (memq 'efs-set-buffer-mode find-file-hooks)
|
|
|
10747 (setq find-file-hooks
|
|
|
10748 (cons 'efs-set-buffer-mode find-file-hooks)))
|
|
|
10749
|
|
|
10750 ;;; We are using our own dired.el, so this doesn't depend on Emacs flavour.
|
|
|
10751
|
|
|
10752 (if (featurep 'dired)
|
|
|
10753 (require 'efs-dired)
|
|
|
10754 (add-hook 'dired-load-hook (function
|
|
|
10755 (lambda ()
|
|
|
10756 (require 'efs-dired)))))
|
|
|
10757
|
|
|
10758 ;;;; ------------------------------------------------------------
|
|
|
10759 ;;;; Add to minor-mode-alist.
|
|
|
10760 ;;;; ------------------------------------------------------------
|
|
|
10761
|
|
|
10762 (or (assq 'efs-process-host-type minor-mode-alist)
|
|
|
10763 (if (assq 'dired-sort-mode minor-mode-alist)
|
|
|
10764 (let ((our-list
|
|
|
10765 (nconc
|
|
|
10766 (delq nil
|
|
|
10767 (list (assq 'dired-sort-mode minor-mode-alist)
|
|
|
10768 (assq 'dired-subdir-omit minor-mode-alist)
|
|
|
10769 (assq 'dired-marker-stack minor-mode-alist)))
|
|
|
10770 (list '(efs-process-host-type efs-process-host-type)
|
|
|
10771 '(efs-dired-listing-type
|
|
|
10772 efs-dired-listing-type-string))))
|
|
|
10773 (old-list (delq
|
|
|
10774 (assq 'efs-process-host-type minor-mode-alist)
|
|
|
10775 (delq
|
|
|
10776 (assq 'efs-dired-listing-type minor-mode-alist)
|
|
|
10777 minor-mode-alist))))
|
|
|
10778 (setq minor-mode-alist nil)
|
|
|
10779 (while old-list
|
|
|
10780 (or (assq (car (car old-list)) our-list)
|
|
|
10781 (setq minor-mode-alist (nconc minor-mode-alist
|
|
|
10782 (list (car old-list)))))
|
|
|
10783 (setq old-list (cdr old-list)))
|
|
|
10784 (setq minor-mode-alist (nconc our-list minor-mode-alist)))
|
|
|
10785 (setq minor-mode-alist
|
|
|
10786 (nconc
|
|
|
10787 (list '(efs-process-host-type efs-process-host-type)
|
|
|
10788 '(efs-dired-listing-type efs-dired-listing-type-string))
|
|
|
10789 minor-mode-alist))))
|
|
|
10790
|
|
|
10791 ;;;; ------------------------------------------------------------
|
|
|
10792 ;;;; File name handlers
|
|
|
10793 ;;;; ------------------------------------------------------------
|
|
|
10794
|
|
40
|
10795 ;;;###autoload
|
|
22
|
10796 (defun efs-file-handler-function (operation &rest args)
|
|
|
10797 "Function to call special file handlers for remote files."
|
|
42
|
10798 (let ((handler (and (if (boundp 'allow-remote-paths)
|
|
|
10799 allow-remote-paths
|
|
|
10800 t)
|
|
|
10801 (get operation 'efs))))
|
|
22
|
10802 (if handler
|
|
|
10803 (apply handler args)
|
|
|
10804 (let ((inhibit-file-name-handlers
|
|
|
10805 (cons 'efs-file-handler-function
|
|
|
10806 (and (eq inhibit-file-name-operation operation)
|
|
|
10807 inhibit-file-name-handlers)))
|
|
|
10808 (inhibit-file-name-operation operation))
|
|
|
10809 (apply operation args)))))
|
|
|
10810
|
|
|
10811 (defun efs-sifn-handler-function (operation &rest args)
|
|
|
10812 ;; Handler function for substitute-in-file-name
|
|
42
|
10813 (if (and (if (boundp 'allow-remote-paths)
|
|
|
10814 allow-remote-paths
|
|
|
10815 t)
|
|
|
10816 (eq operation 'substitute-in-file-name))
|
|
22
|
10817 (apply 'efs-substitute-in-file-name args)
|
|
|
10818 (let ((inhibit-file-name-handlers
|
|
|
10819 (cons 'efs-sifn-handler-function
|
|
|
10820 (and (eq operation inhibit-file-name-operation)
|
|
|
10821 inhibit-file-name-handlers)))
|
|
|
10822 (inhibit-file-name-operation operation))
|
|
|
10823 (apply operation args))))
|
|
|
10824
|
|
|
10825 ;; Yes, this is what it looks like. I'm defining the handler to run our
|
|
|
10826 ;; version whenever there is an environment variable.
|
|
|
10827
|
|
48
|
10828 (defvar efs-path-sifn-regexp "\\(^\\|[^$]\\)\\(\\$\\$\\)*\\$[{a-zA-Z0-9]"
|
|
|
10829 "Regexp to match environment variables in file names.")
|
|
|
10830
|
|
|
10831 (or (assoc efs-path-sifn-regexp file-name-handler-alist)
|
|
|
10832 (nconc file-name-handler-alist
|
|
|
10833 (list
|
|
|
10834 (cons efs-path-sifn-regexp
|
|
|
10835 'efs-sifn-handler-function))))
|
|
22
|
10836
|
|
|
10837 ;;;; ------------------------------------------------------------
|
|
|
10838 ;;;; Necessary overloads.
|
|
|
10839 ;;;; ------------------------------------------------------------
|
|
|
10840
|
|
|
10841 ;;; The following functions are overloaded, instead of extended via
|
|
|
10842 ;;; the file-name-handler-alist. For various reasons, the
|
|
|
10843 ;;; file-name-handler-alist doesn't work for them. It would be nice if
|
|
|
10844 ;;; this list could be shortened in the future.
|
|
|
10845
|
|
|
10846 ;; File name exansion. It is not until _after_ a file name has been
|
|
|
10847 ;; expanded that it is reasonable to test it for a file name handler.
|
|
|
10848 (efs-overwrite-fn "efs" 'expand-file-name)
|
|
|
10849
|
|
|
10850 ;; Loading lisp files. The problem with using the file-name-handler-alist
|
|
|
10851 ;; here is that we don't know what is to be handled, until after searching
|
|
|
10852 ;; the load-path. The solution is to change the C code for Fload.
|
|
|
10853 ;; A patch to do this has been written by Jay Adams <jka@ece.cmu.edu>.
|
|
|
10854 (efs-overwrite-fn "efs" 'load)
|
|
|
10855 (efs-overwrite-fn "efs" 'require)
|
|
|
10856
|
|
|
10857 ;;;; ------------------------------------------------------------
|
|
|
10858 ;;;; Install the file handlers for efs-file-handler-function.
|
|
|
10859 ;;;; ------------------------------------------------------------
|
|
|
10860
|
|
|
10861 ;; I/O
|
|
|
10862 (put 'insert-file-contents 'efs 'efs-insert-file-contents)
|
|
|
10863 (put 'write-region 'efs 'efs-write-region)
|
|
|
10864 (put 'directory-files 'efs 'efs-directory-files)
|
|
|
10865 (put 'list-directory 'efs 'efs-list-directory)
|
|
|
10866 (put 'insert-directory 'efs 'efs-insert-directory)
|
|
|
10867 (put 'recover-file 'efs 'efs-recover-file)
|
|
|
10868 ;; file properties
|
|
|
10869 (put 'file-directory-p 'efs 'efs-file-directory-p)
|
|
|
10870 (put 'file-writable-p 'efs 'efs-file-writable-p)
|
|
|
10871 (put 'file-readable-p 'efs 'efs-file-readable-p)
|
|
|
10872 (put 'file-executable-p 'efs 'efs-file-executable-p)
|
|
|
10873 (put 'file-symlink-p 'efs 'efs-file-symlink-p)
|
|
|
10874 (put 'file-attributes 'efs 'efs-file-attributes)
|
|
|
10875 (put 'file-exists-p 'efs 'efs-file-exists-p)
|
|
|
10876 (put 'file-accessible-directory-p 'efs 'efs-file-accessible-directory-p)
|
|
|
10877 ;; manipulating file names
|
|
|
10878 (put 'file-name-directory 'efs 'efs-file-name-directory)
|
|
|
10879 (put 'file-name-nondirectory 'efs 'efs-file-name-nondirectory)
|
|
|
10880 (put 'file-name-as-directory 'efs 'efs-file-name-as-directory)
|
|
|
10881 (put 'directory-file-name 'efs 'efs-directory-file-name)
|
|
|
10882 (put 'abbreviate-file-name 'efs 'efs-abbreviate-file-name)
|
|
|
10883 (put 'file-name-sans-versions 'efs 'efs-file-name-sans-versions)
|
|
|
10884 (put 'unhandled-file-name-directory 'efs 'efs-unhandled-file-name-directory)
|
|
|
10885 (put 'diff-latest-backup-file 'efs 'efs-diff-latest-backup-file)
|
|
|
10886 (put 'file-truename 'efs 'efs-file-truename)
|
|
|
10887 ;; modtimes
|
|
|
10888 (put 'verify-visited-file-modtime 'efs 'efs-verify-visited-file-modtime)
|
|
|
10889 (put 'file-newer-than-file-p 'efs 'efs-file-newer-than-file-p)
|
|
|
10890 (put 'set-visited-file-modtime 'efs 'efs-set-visited-file-modtime)
|
|
|
10891 ;; file modes
|
|
|
10892 (put 'set-file-modes 'efs 'efs-set-file-modes)
|
|
|
10893 (put 'file-modes 'efs 'efs-file-modes)
|
|
|
10894 ;; buffers
|
|
|
10895 (put 'backup-buffer 'efs 'efs-backup-buffer)
|
|
|
10896 (put 'get-file-buffer 'efs 'efs-get-file-buffer)
|
|
|
10897 (put 'create-file-buffer 'efs 'efs-create-file-buffer)
|
|
|
10898 ;; creating and removing files
|
|
|
10899 (put 'delete-file 'efs 'efs-delete-file)
|
|
|
10900 (put 'copy-file 'efs 'efs-copy-file)
|
|
|
10901 (put 'rename-file 'efs 'efs-rename-file)
|
|
|
10902 (put 'file-local-copy 'efs 'efs-file-local-copy)
|
|
|
10903 (put 'make-directory-internal 'efs 'efs-make-directory-internal)
|
|
|
10904 (put 'delete-directory 'efs 'efs-delete-directory)
|
|
|
10905 (put 'add-name-to-file 'efs 'efs-add-name-to-file)
|
|
|
10906 (put 'make-symbolic-link 'efs 'efs-make-symbolic-link)
|
|
|
10907 ;; file name completion
|
|
|
10908 (put 'file-name-completion 'efs 'efs-file-name-completion)
|
|
|
10909 (put 'file-name-all-completions 'efs 'efs-file-name-all-completions)
|
|
|
10910
|
|
|
10911 ;;;; ------------------------------------------------------------
|
|
|
10912 ;;;; Finally run any load-hooks.
|
|
|
10913 ;;;; ------------------------------------------------------------
|
|
|
10914
|
|
|
10915 (run-hooks 'efs-load-hook)
|
|
|
10916
|
|
|
10917 ;;; end of efs.el
|
