X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/442c9ab62723c834867a2402e2c84af9bb2003dc..c4fb6a3cd68fdfc5cf8acc946482a76d1eb16e8d:/lisp/ange-ftp.el diff --git a/lisp/ange-ftp.el b/lisp/ange-ftp.el index f359cbe8d7..434eaf046c 100644 --- a/lisp/ange-ftp.el +++ b/lisp/ange-ftp.el @@ -1,616 +1,625 @@ ;;; ange-ftp.el --- transparent FTP support for GNU Emacs -;;; Copyright (C) 1989, 1990, 1991, 1992, 1993 Free Software Foundation, Inc. -;;; +;; Copyright (C) 1989,90,91,92,93,94,95,96 Free Software Foundation, Inc. + ;; Author: Andy Norman (ange@hplb.hpl.hp.com) +;; Maintainer: FSF ;; Keywords: comm -;;; -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; A copy of the GNU General Public License can be obtained from this -;;; program's author (send electronic mail to ange@hplb.hpl.hp.com) or from -;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA -;;; 02139, USA. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. ;;; Commentary: -;;; -;;; This package attempts to make accessing files and directories using FTP -;;; from within GNU Emacs as simple and transparent as possible. A subset of -;;; the common file-handling routines are extended to interact with FTP. - -;;; Usage: -;;; -;;; Some of the common GNU Emacs file-handling operations have been made -;;; FTP-smart. If one of these routines is given a filename that matches -;;; '/user@host:name' then it will spawn an FTP process connecting to machine -;;; 'host' as account 'user' and perform its operation on the file 'name'. -;;; -;;; For example: if find-file is given a filename of: -;;; -;;; /ange@anorman:/tmp/notes -;;; -;;; then ange-ftp spawns an FTP process, connect to the host 'anorman' as -;;; user 'ange', get the file '/tmp/notes' and pop up a buffer containing the -;;; contents of that file as if it were on the local filesystem. If ange-ftp -;;; needs a password to connect then it reads one in the echo area. - -;;; Extended filename syntax: -;;; -;;; The default extended filename syntax is '/user@host:name', where the -;;; 'user@' part may be omitted. This syntax can be customised to a certain -;;; extent by changing ange-ftp-name-format. There are limitations. -;;; -;;; If the user part is omitted then ange-ftp generates a default user -;;; instead whose value depends on the variable ange-ftp-default-user. - -;;; Passwords: -;;; -;;; A password is required for each host/user pair. Ange-ftp reads passwords -;;; as needed. You can also specify a password with ange-ftp-set-passwd, or -;;; in a *valid* ~/.netrc file. - -;;; Passwords for user "anonymous": -;;; -;;; Passwords for the user "anonymous" (or "ftp") are handled -;;; specially. The variable `ange-ftp-generate-anonymous-password' -;;; controls what happens: if the value of this variable is a string, -;;; then this is used as the password; if non-nil (the default), then -;;; a password is created from the name of the user and the hostname -;;; of the machine on which GNU Emacs is running; if nil then the user -;;; is prompted for a password as normal. - -;;; "Dumb" UNIX hosts: -;;; -;;; The FTP servers on some UNIX machines have problems if the 'ls' command is -;;; used. -;;; -;;; The routine ange-ftp-add-dumb-unix-host can be called to tell ange-ftp to -;;; limit itself to the DIR command and not 'ls' for a given UNIX host. Note -;;; that this change will take effect for the current GNU Emacs session only. -;;; See below for a discussion of non-UNIX hosts. If a large number of -;;; machines with similar hostnames have this problem then it is easier to set -;;; the value of ange-ftp-dumb-unix-host-regexp in your .emacs file. ange-ftp -;;; is unable to automatically recognize dumb unix hosts. - -;;; File name completion: -;;; -;;; Full file-name completion is supported on UNIX, VMS, CMS, and MTS hosts. -;;; To do filename completion, ange-ftp needs a listing from the remote host. -;;; Therefore, for very slow connections, it might not save any time. - -;;; FTP processes: -;;; -;;; When ange-ftp starts up an FTP process, it leaves it running for speed -;;; purposes. Some FTP servers will close the connection after a period of -;;; time, but ange-ftp should be able to quietly reconnect the next time that -;;; the process is needed. -;;; -;;; Killing the "*ftp user@host*" buffer also kills the ftp process. -;;; This should not cause ange-ftp any grief. - -;;; Binary file transfers: -;;; -;;; By default ange-ftp transfers files in ASCII mode. If a file being -;;; transferred matches the value of ange-ftp-binary-file-name-regexp then -;;; binary mode is used for that transfer. - -;;; Account passwords: -;;; -;;; Some FTP servers require an additional password which is sent by the -;;; ACCOUNT command. ange-ftp partially supports this by allowing the user to -;;; specify an account password by either calling ange-ftp-set-account, or by -;;; specifying an account token in the .netrc file. If the account password -;;; is set by either of these methods then ange-ftp will issue an ACCOUNT -;;; command upon starting the FTP process. - -;;; Preloading: -;;; -;;; ange-ftp can be preloaded, but must be put in the site-init.el file and -;;; not the site-load.el file in order for the documentation strings for the -;;; functions being overloaded to be available. - -;;; Status reports: -;;; -;;; Most ange-ftp commands that talk to the FTP process output a status -;;; message on what they are doing. In addition, ange-ftp can take advantage -;;; of the FTP client's HASH command to display the status of transferring -;;; files and listing directories. See the documentation for the variables -;;; ange-ftp-{ascii,binary}-hash-mark-size, ange-ftp-send-hash and -;;; ange-ftp-process-verbose for more details. - -;;; Gateways: -;;; -;;; Sometimes it is necessary for the FTP process to be run on a different -;;; machine than the machine running GNU Emacs. This can happen when the -;;; local machine has restrictions on what hosts it can access. -;;; -;;; ange-ftp has support for running the ftp process on a different (gateway) -;;; machine. The way it works is as follows: -;;; -;;; 1) Set the variable 'ange-ftp-gateway-host' to the name of a machine -;;; that doesn't have the access restrictions. -;;; -;;; 2) Set the variable 'ange-ftp-local-host-regexp' to a regular expression -;;; that matches hosts that can be contacted from running a local ftp -;;; process, but fails to match hosts that can't be accessed locally. For -;;; example: -;;; -;;; "\\.hp\\.com$\\|^[^.]*$" -;;; -;;; will match all hosts that are in the .hp.com domain, or don't have an -;;; explicit domain in their name, but will fail to match hosts with -;;; explicit domains or that are specified by their ip address. -;;; -;;; 3) Using NFS and symlinks, make sure that there is a shared directory with -;;; the *same* name between the local machine and the gateway machine. -;;; This directory is necessary for temporary files created by ange-ftp. -;;; -;;; 4) Set the variable 'ange-ftp-gateway-tmp-name-template' to the name of -;;; this directory plus an identifying filename prefix. For example: -;;; -;;; "/nfs/hplose/ange/ange-ftp" -;;; -;;; where /nfs/hplose/ange is a directory that is shared between the -;;; gateway machine and the local machine. -;;; -;;; The simplest way of getting a ftp process running on the gateway machine -;;; is if you can spawn a remote shell using either 'rsh' or 'remsh'. If you -;;; can't do this for some reason such as security then points 7 onwards will -;;; discuss an alternative approach. -;;; -;;; 5) Set the variable ange-ftp-gateway-program to the name of the remote -;;; shell process such as 'remsh' or 'rsh' if the default isn't correct. -;;; -;;; 6) Set the variable ange-ftp-gateway-program-interactive to nil if it -;;; isn't already. This tells ange-ftp that you are using a remote shell -;;; rather than logging in using telnet or rlogin. -;;; -;;; That should be all you need to allow ange-ftp to spawn a ftp process on -;;; the gateway machine. If you have to use telnet or rlogin to get to the -;;; gateway machine then follow the instructions below. -;;; -;;; 7) Set the variable ange-ftp-gateway-program to the name of the program -;;; that lets you log onto the gateway machine. This may be something like -;;; telnet or rlogin. -;;; -;;; 8) Set the variable ange-ftp-gateway-prompt-pattern to a regular -;;; expression that matches the prompt you get when you login to the -;;; gateway machine. Be very specific here; this regexp must not match -;;; *anything* in your login banner except this prompt. -;;; shell-prompt-pattern is far too general as it appears to match some -;;; login banners from Sun machines. For example: -;;; -;;; "^$*$ *" -;;; -;;; 9) Set the variable ange-ftp-gateway-program-interactive to 't' to let -;;; ange-ftp know that it has to "hand-hold" the login to the gateway -;;; machine. -;;; -;;; 10) Set the variable ange-ftp-gateway-setup-term-command to a UNIX command -;;; that will put the pty connected to the gateway machine into a -;;; no-echoing mode, and will strip off carriage-returns from output from -;;; the gateway machine. For example: -;;; -;;; "stty -onlcr -echo" -;;; -;;; will work on HP-UX machines, whereas: -;;; -;;; "stty -echo nl" -;;; -;;; appears to work for some Sun machines. -;;; -;;; That's all there is to it. - -;;; Smart gateways: -;;; -;;; If you have a "smart" ftp program that allows you to issue commands like -;;; "USER foo@bar" which do nice proxy things, then look at the variables -;;; ange-ftp-smart-gateway and ange-ftp-smart-gateway-port. - -;;; Tips for using ange-ftp: -;;; -;;; 1. For dired to work on a host which marks symlinks with a trailing @ in -;;; an ls -alF listing, you need to (setq dired-ls-F-marks-symlinks t). -;;; Most UNIX systems do not do this, but ULTRIX does. If you think that -;;; there is a chance you might connect to an ULTRIX machine (such as -;;; prep.ai.mit.edu), then set this variable accordingly. This will have -;;; the side effect that dired will have problems with symlinks whose names -;;; end in an @. If you get yourself into this situation then editing -;;; dired's ls-switches to remove "F", will temporarily fix things. -;;; -;;; 2. If you know that you are connecting to a certain non-UNIX machine -;;; frequently, and ange-ftp seems to be unable to guess its host-type, -;;; then setting the appropriate host-type regexp -;;; (ange-ftp-vms-host-regexp, ange-ftp-mts-host-regexp, or -;;; ange-ftp-cms-host-regexp) accordingly should help. Also, please report -;;; ange-ftp's inability to recognize the host-type as a bug. -;;; -;;; 3. For slow connections, you might get "listing unreadable" error -;;; messages, or get an empty buffer for a file that you know has something -;;; in it. The solution is to increase the value of ange-ftp-retry-time. -;;; Its default value is 5 which is plenty for reasonable connections. -;;; However, for some transatlantic connections I set this to 20. -;;; -;;; 4. Beware of compressing files on non-UNIX hosts. Ange-ftp will do it by -;;; copying the file to the local machine, compressing it there, and then -;;; sending it back. Binary file transfers between machines of different -;;; architectures can be a risky business. Test things out first on some -;;; test files. See "Bugs" below. Also, note that ange-ftp copies files by -;;; moving them through the local machine. Again, be careful when doing -;;; this with binary files on non-Unix machines. -;;; -;;; 5. Beware that dired over ftp will use your setting of dired-no-confirm -;;; (list of dired commands for which confirmation is not asked). You -;;; might want to reconsider your setting of this variable, because you -;;; might want confirmation for more commands on remote direds than on -;;; local direds. For example, I strongly recommend that you not include -;;; compress and uncompress in this list. If there is enough demand it -;;; might be a good idea to have an alist ange-ftp-dired-no-confirm of -;;; pairs ( TYPE . LIST ), where TYPE is an operating system type and LIST -;;; is a list of commands for which confirmation would be suppressed. Then -;;; remote dired listings would take their (buffer-local) value of -;;; dired-no-confirm from this alist. Who votes for this? - -;;; --------------------------------------------------------------------- -;;; Non-UNIX support: -;;; --------------------------------------------------------------------- - -;;; VMS support: -;;; -;;; Ange-ftp has full support for VMS hosts. It -;;; should be able to automatically recognize any VMS machine. However, if it -;;; fails to do this, you can use the command ange-ftp-add-vms-host. As well, -;;; you can set the variable ange-ftp-vms-host-regexp in your .emacs file. We -;;; would be grateful if you would report any failures to automatically -;;; recognize a VMS host as a bug. -;;; -;;; Filename Syntax: -;;; -;;; For ease of *implementation*, the user enters the VMS filename syntax in a -;;; UNIX-y way. For example: -;;; PUB$:[ANONYMOUS.SDSCPUB.NEXT]README.TXT;1 -;;; would be entered as: -;;; /PUB$$:/ANONYMOUS/SDSCPUB/NEXT/README.TXT;1 -;;; i.e. to log in as anonymous on ymir.claremont.edu and grab the file: -;;; [.CSV.POLICY]RULES.MEM -;;; you would type: -;;; C-x C-f /anonymous@ymir.claremont.edu:CSV/POLICY/RULES.MEM -;;; -;;; A legal VMS filename is of the form: FILE.TYPE;## -;;; where FILE can be up to 39 characters -;;; TYPE can be up to 39 characters -;;; ## is a version number (an integer between 1 and 32,767) -;;; Valid characters in FILE and TYPE are A-Z 0-9 _ - $ -;;; $ cannot begin a filename, and - cannot be used as the first or last -;;; character. -;;; -;;; Tips: -;;; 1. Although VMS is not case sensitive, EMACS running under UNIX is. -;;; Therefore, to access a VMS file, you must enter the filename with upper -;;; case letters. -;;; 2. To access the latest version of file under VMS, you use the filename -;;; without the ";" and version number. You should always edit the latest -;;; version of a file. If you want to edit an earlier version, copy it to a -;;; new file first. This has nothing to do with ange-ftp, but is simply -;;; good VMS operating practice. Therefore, to edit FILE.TXT;3 (say 3 is -;;; latest version), do C-x C-f /ymir.claremont.edu:FILE.TXT. If you -;;; inadvertently do C-x C-f /ymir.claremont.edu:FILE.TXT;3, you will find -;;; that VMS will not allow you to save the file because it will refuse to -;;; overwrite FILE.TXT;3, but instead will want to create FILE.TXT;4, and -;;; attach the buffer to this file. To get out of this situation, M-x -;;; write-file /ymir.claremont.edu:FILE.TXT will attach the buffer to -;;; latest version of the file. For this reason, in dired "f" -;;; (dired-find-file), always loads the file sans version, whereas "v", -;;; (dired-view-file), always loads the explicit version number. The -;;; reasoning being that it reasonable to view old versions of a file, but -;;; not to edit them. -;;; 3. EMACS has a feature in which it does environment variable substitution -;;; in filenames. Therefore, to enter a $ in a filename, you must quote it -;;; by typing $$. - -;;; MTS support: -;;; -;;; Ange-ftp has full support for hosts running -;;; the Michigan terminal system. It should be able to automatically -;;; recognize any MTS machine. However, if it fails to do this, you can use -;;; the command ange-ftp-add-mts-host. As well, you can set the variable -;;; ange-ftp-mts-host-regexp in your .emacs file. We would be grateful if you -;;; would report any failures to automatically recognize a MTS host as a bug. -;;; -;;; Filename syntax: -;;; -;;; MTS filenames are entered in a UNIX-y way. For example, if your account -;;; was YYYY, the file FILE in the account XXXX: on mtsg.ubc.ca would be -;;; entered as -;;; /YYYY@mtsg.ubc.ca:/XXXX:/FILE -;;; In other words, MTS accounts are treated as UNIX directories. Of course, -;;; to access a file in another account, you must have access permission for -;;; it. If FILE were in your own account, then you could enter it in a -;;; relative name fashion as -;;; /YYYY@mtsg.ubc.ca:FILE -;;; MTS filenames can be up to 12 characters. Like UNIX, the structure of the -;;; filename does not contain a TYPE (i.e. it can have as many "."'s as you -;;; like.) MTS filenames are always in upper case, and hence be sure to enter -;;; them as such! MTS is not case sensitive, but an EMACS running under UNIX -;;; is. - -;;; CMS support: -;;; -;;; Ange-ftp has full support for hosts running -;;; CMS. It should be able to automatically recognize any CMS machine. -;;; However, if it fails to do this, you can use the command -;;; ange-ftp-add-cms-host. As well, you can set the variable -;;; ange-ftp-cms-host-regexp in your .emacs file. We would be grateful if you -;;; would report any failures to automatically recognize a CMS host as a bug. -;;; -;;; Filename syntax: -;;; -;;; CMS filenames are entered in a UNIX-y way. In otherwords, minidisks are -;;; treated as UNIX directories. For example to access the file READ.ME in -;;; minidisk *.311 on cuvmb.cc.columbia.edu, you would enter -;;; /anonymous@cuvmb.cc.columbia.edu:/*.311/READ.ME -;;; If *.301 is the default minidisk for this account, you could access -;;; FOO.BAR on this minidisk as -;;; /anonymous@cuvmb.cc.columbia.edu:FOO.BAR -;;; CMS filenames are of the form FILE.TYPE, where both FILE and TYPE can be -;;; up to 8 characters. Again, beware that CMS filenames are always upper -;;; case, and hence must be entered as such. -;;; -;;; Tips: -;;; 1. CMS machines, with the exception of anonymous accounts, nearly always -;;; need an account password. To have ange-ftp send an account password, -;;; you can either include it in your .netrc file, or use -;;; ange-ftp-set-account. -;;; 2. Ange-ftp cannot send "write passwords" for a minidisk. Hopefully, we -;;; can fix this. -;;; -;;; ------------------------------------------------------------------ -;;; Bugs: -;;; ------------------------------------------------------------------ -;;; -;;; 1. Umask problems: -;;; Be warned that files created by using ange-ftp will take account of the -;;; umask of the ftp daemon process rather than the umask of the creating -;;; user. This is particularly important when logging in as the root user. -;;; The way that I tighten up the ftp daemon's umask under HP-UX is to make -;;; sure that the umask is changed to 027 before I spawn /etc/inetd. I -;;; suspect that there is something similar on other systems. -;;; -;;; 2. Some combinations of FTP clients and servers break and get out of sync -;;; when asked to list a non-existent directory. Some of the ai.mit.edu -;;; machines cause this problem for some FTP clients. Using -;;; ange-ftp-kill-process can be used to restart the ftp process, which -;;; should get things back in synch. -;;; -;;; 3. Ange-ftp does not check to make sure that when creating a new file, -;;; you provide a valid filename for the remote operating system. -;;; If you do not, then the remote FTP server will most likely -;;; translate your filename in some way. This may cause ange-ftp to -;;; get confused about what exactly is the name of the file. The -;;; most common causes of this are using lower case filenames on systems -;;; which support only upper case, and using filenames which are too -;;; long. -;;; -;;; 4. Null (blank) passwords confuse both ange-ftp and some FTP daemons. -;;; -;;; 5. Ange-ftp likes to use pty's to talk to its FTP processes. If GNU Emacs -;;; for some reason creates a FTP process that only talks via pipes then -;;; ange-ftp won't be getting the information it requires at the time that -;;; it wants it since pipes flush at different times to pty's. One -;;; disgusting way around this problem is to talk to the FTP process via -;;; rlogin which does the 'right' things with pty's. -;;; -;;; 6. For CMS support, we send too many cd's. Since cd's are cheap, I haven't -;;; worried about this too much. Eventually, we should have some caching -;;; of the current minidisk. -;;; -;;; 7. Some CMS machines do not assign a default minidisk when you ftp them as -;;; anonymous. It is then necessary to guess a valid minidisk name, and cd -;;; to it. This is (understandably) beyond ange-ftp. -;;; -;;; 8. Remote to remote copying of files on non-Unix machines can be risky. -;;; Depending on the variable ange-ftp-binary-file-name-regexp, ange-ftp -;;; will use binary mode for the copy. Between systems of different -;;; architecture, this still may not be enough to guarantee the integrity -;;; of binary files. Binary file transfers from VMS machines are -;;; particularly problematical. Should ange-ftp-binary-file-name-regexp be -;;; an alist of OS type, regexp pairs? -;;; -;;; 9. The code to do compression of files over ftp is not as careful as it -;;; should be. It deletes the old remote version of the file, before -;;; actually checking if the local to remote transfer of the compressed -;;; file succeeds. Of course to delete the original version of the file -;;; after transferring the compressed version back is also dangerous, -;;; because some OS's have severe restrictions on the length of filenames, -;;; and when the compressed version is copied back the "-Z" or ".Z" may be -;;; truncated. Then, ange-ftp would delete the only remaining version of -;;; the file. Maybe ange-ftp should make backups when it compresses files -;;; (of course, the backup "~" could also be truncated off, sigh...). -;;; Suggestions? -;;; - -;;; 10. If a dir listing is attempted for an empty directory on (at least -;;; some) VMS hosts, an ftp error is given. This is really an ftp bug, and -;;; I don't know how to get ange-ftp work to around it. -;;; -;;; 11. Bombs on filenames that start with a space. Deals well with filenames -;;; containing spaces, but beware that the remote ftpd may not like them -;;; much. -;;; -;;; 12. The dired support for non-Unix-like systems does not currently work. -;;; It needs to be reimplemented by modifying the parse-...-listing -;;; functions to convert the directory listing to ls -l format. -;;; -;;; 13. The famous @ bug. As mentioned above in TIPS, ULTRIX marks symlinks -;;; with a trailing @ in a ls -alF listing. In order to account for this -;;; ange-ftp looks to chop trailing @'s off of symlink names when it is -;;; parsing a listing with the F switch. This will cause ange-ftp to -;;; incorrectly get the name of a symlink on a non-ULTRIX host if its name -;;; ends in an @. ange-ftp will correct itself if you take F out of the -;;; dired ls switches (C-u s will allow you to edit the switches). The -;;; dired buffer will be automatically reverted, which will allow ange-ftp -;;; to fix its files hashtable. A cookie to anyone who can think of a -;;; fast, sure-fire way to recognize ULTRIX over ftp. - -;;; If you find any bugs or problems with this package, PLEASE either e-mail -;;; the above author, or send a message to the ange-ftp-lovers mailing list -;;; below. Ideas and constructive comments are especially welcome. - -;;; ange-ftp-lovers: -;;; -;;; ange-ftp has its own mailing list modestly called ange-ftp-lovers. All -;;; users of ange-ftp are welcome to subscribe (see below) and to discuss -;;; aspects of ange-ftp. New versions of ange-ftp are posted periodically to -;;; the mailing list. -;;; -;;; To [un]subscribe to ange-ftp-lovers, or to report mailer problems with the -;;; list, please mail one of the following addresses: -;;; -;;; ange-ftp-lovers-request@anorman.hpl.hp.com -;;; or -;;; ange-ftp-lovers-request%anorman.hpl.hp.com@hplb.hpl.hp.com -;;; -;;; Please don't forget the -request part. -;;; -;;; For mail to be posted directly to ange-ftp-lovers, send to one of the -;;; following addresses: -;;; -;;; ange-ftp-lovers@anorman.hpl.hp.com -;;; or -;;; ange-ftp-lovers%anorman.hpl.hp.com@hplb.hpl.hp.com -;;; -;;; Alternatively, there is a mailing list that only gets announcements of new -;;; ange-ftp releases. This is called ange-ftp-lovers-announce, and can be -;;; subscribed to by e-mailing to the -request address as above. Please make -;;; it clear in the request which mailing list you wish to join. - -;;; The latest version of ange-ftp can usually be obtained via anonymous ftp -;;; from: -;;; alpha.gnu.ai.mit.edu:ange-ftp/ange-ftp.tar.Z -;;; or: -;;; ugle.unit.no:/pub/gnu/emacs-lisp/ange-ftp.tar.Z -;;; or: -;;; archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/packages/ange-ftp.tar.Z - -;;; The archives for ange-ftp-lovers can be found via anonymous ftp under: -;;; -;;; ftp.reed.edu:pub/mailing-lists/ange-ftp/ + +;; This package attempts to make accessing files and directories using FTP +;; from within GNU Emacs as simple and transparent as possible. A subset of +;; the common file-handling routines are extended to interact with FTP. + +;; Usage: +;; +;; Some of the common GNU Emacs file-handling operations have been made +;; FTP-smart. If one of these routines is given a filename that matches +;; '/user@host:name' then it will spawn an FTP process connecting to machine +;; 'host' as account 'user' and perform its operation on the file 'name'. +;; +;; For example: if find-file is given a filename of: +;; +;; /ange@anorman:/tmp/notes +;; +;; then ange-ftp spawns an FTP process, connect to the host 'anorman' as +;; user 'ange', get the file '/tmp/notes' and pop up a buffer containing the +;; contents of that file as if it were on the local filesystem. If ange-ftp +;; needs a password to connect then it reads one in the echo area. + +;; Extended filename syntax: +;; +;; The default extended filename syntax is '/user@host:name', where the +;; 'user@' part may be omitted. This syntax can be customised to a certain +;; extent by changing ange-ftp-name-format. There are limitations. +;; +;; If the user part is omitted then ange-ftp generates a default user +;; instead whose value depends on the variable ange-ftp-default-user. + +;; Passwords: +;; +;; A password is required for each host/user pair. Ange-ftp reads passwords +;; as needed. You can also specify a password with ange-ftp-set-passwd, or +;; in a *valid* ~/.netrc file. + +;; Passwords for user "anonymous": +;; +;; Passwords for the user "anonymous" (or "ftp") are handled +;; specially. The variable `ange-ftp-generate-anonymous-password' +;; controls what happens: if the value of this variable is a string, +;; then this is used as the password; if non-nil (the default), then +;; the value of `user-mail-address' is used; if nil then the user +;; is prompted for a password as normal. + +;; "Dumb" UNIX hosts: +;; +;; The FTP servers on some UNIX machines have problems if the 'ls' command is +;; used. +;; +;; The routine ange-ftp-add-dumb-unix-host can be called to tell ange-ftp to +;; limit itself to the DIR command and not 'ls' for a given UNIX host. Note +;; that this change will take effect for the current GNU Emacs session only. +;; See below for a discussion of non-UNIX hosts. If a large number of +;; machines with similar hostnames have this problem then it is easier to set +;; the value of ange-ftp-dumb-unix-host-regexp in your .emacs file. ange-ftp +;; is unable to automatically recognize dumb unix hosts. + +;; File name completion: +;; +;; Full file-name completion is supported on UNIX, VMS, CMS, and MTS hosts. +;; To do filename completion, ange-ftp needs a listing from the remote host. +;; Therefore, for very slow connections, it might not save any time. + +;; FTP processes: +;; +;; When ange-ftp starts up an FTP process, it leaves it running for speed +;; purposes. Some FTP servers will close the connection after a period of +;; time, but ange-ftp should be able to quietly reconnect the next time that +;; the process is needed. +;; +;; Killing the "*ftp user@host*" buffer also kills the ftp process. +;; This should not cause ange-ftp any grief. + +;; Binary file transfers: +;; +;; By default ange-ftp transfers files in ASCII mode. If a file being +;; transferred matches the value of ange-ftp-binary-file-name-regexp then +;; binary mode is used for that transfer. + +;; Account passwords: +;; +;; Some FTP servers require an additional password which is sent by the +;; ACCOUNT command. ange-ftp partially supports this by allowing the user to +;; specify an account password by either calling ange-ftp-set-account, or by +;; specifying an account token in the .netrc file. If the account password +;; is set by either of these methods then ange-ftp will issue an ACCOUNT +;; command upon starting the FTP process. + +;; Preloading: +;; +;; ange-ftp can be preloaded, but must be put in the site-init.el file and +;; not the site-load.el file in order for the documentation strings for the +;; functions being overloaded to be available. + +;; Status reports: +;; +;; Most ange-ftp commands that talk to the FTP process output a status +;; message on what they are doing. In addition, ange-ftp can take advantage +;; of the FTP client's HASH command to display the status of transferring +;; files and listing directories. See the documentation for the variables +;; ange-ftp-{ascii,binary}-hash-mark-size, ange-ftp-send-hash and +;; ange-ftp-process-verbose for more details. + +;; Gateways: +;; +;; Sometimes it is necessary for the FTP process to be run on a different +;; machine than the machine running GNU Emacs. This can happen when the +;; local machine has restrictions on what hosts it can access. +;; +;; ange-ftp has support for running the ftp process on a different (gateway) +;; machine. The way it works is as follows: +;; +;; 1) Set the variable 'ange-ftp-gateway-host' to the name of a machine +;; that doesn't have the access restrictions. +;; +;; 2) Set the variable 'ange-ftp-local-host-regexp' to a regular expression +;; that matches hosts that can be contacted from running a local ftp +;; process, but fails to match hosts that can't be accessed locally. For +;; example: +;; +;; "\\.hp\\.com$\\|^[^.]*$" +;; +;; will match all hosts that are in the .hp.com domain, or don't have an +;; explicit domain in their name, but will fail to match hosts with +;; explicit domains or that are specified by their ip address. +;; +;; 3) Using NFS and symlinks, make sure that there is a shared directory with +;; the *same* name between the local machine and the gateway machine. +;; This directory is necessary for temporary files created by ange-ftp. +;; +;; 4) Set the variable 'ange-ftp-gateway-tmp-name-template' to the name of +;; this directory plus an identifying filename prefix. For example: +;; +;; "/nfs/hplose/ange/ange-ftp" +;; +;; where /nfs/hplose/ange is a directory that is shared between the +;; gateway machine and the local machine. +;; +;; The simplest way of getting a ftp process running on the gateway machine +;; is if you can spawn a remote shell using either 'rsh' or 'remsh'. If you +;; can't do this for some reason such as security then points 7 onwards will +;; discuss an alternative approach. +;; +;; 5) Set the variable ange-ftp-gateway-program to the name of the remote +;; shell process such as 'remsh' or 'rsh' if the default isn't correct. +;; +;; 6) Set the variable ange-ftp-gateway-program-interactive to nil if it +;; isn't already. This tells ange-ftp that you are using a remote shell +;; rather than logging in using telnet or rlogin. +;; +;; That should be all you need to allow ange-ftp to spawn a ftp process on +;; the gateway machine. If you have to use telnet or rlogin to get to the +;; gateway machine then follow the instructions below. +;; +;; 7) Set the variable ange-ftp-gateway-program to the name of the program +;; that lets you log onto the gateway machine. This may be something like +;; telnet or rlogin. +;; +;; 8) Set the variable ange-ftp-gateway-prompt-pattern to a regular +;; expression that matches the prompt you get when you login to the +;; gateway machine. Be very specific here; this regexp must not match +;; *anything* in your login banner except this prompt. +;; shell-prompt-pattern is far too general as it appears to match some +;; login banners from Sun machines. For example: +;; +;; "^$*$ *" +;; +;; 9) Set the variable ange-ftp-gateway-program-interactive to 't' to let +;; ange-ftp know that it has to "hand-hold" the login to the gateway +;; machine. +;; +;; 10) Set the variable ange-ftp-gateway-setup-term-command to a UNIX command +;; that will put the pty connected to the gateway machine into a +;; no-echoing mode, and will strip off carriage-returns from output from +;; the gateway machine. For example: +;; +;; "stty -onlcr -echo" +;; +;; will work on HP-UX machines, whereas: +;; +;; "stty -echo nl" +;; +;; appears to work for some Sun machines. +;; +;; That's all there is to it. + +;; Smart gateways: +;; +;; If you have a "smart" ftp program that allows you to issue commands like +;; "USER foo@bar" which do nice proxy things, then look at the variables +;; ange-ftp-smart-gateway and ange-ftp-smart-gateway-port. +;; +;; Otherwise, if there is an alternate ftp program that implements proxy in +;; a transparent way (i.e. w/o specifying the proxy host), that will +;; connect you directly to the desired destination host: +;; Set ange-ftp-gateway-ftp-program-name to that program's name. +;; Set ange-ftp-local-host-regexp to a value as stated earlier on. +;; Leave ange-ftp-gateway-host set to nil. +;; Set ange-ftp-smart-gateway to t. + +;; Tips for using ange-ftp: +;; +;; 1. For dired to work on a host which marks symlinks with a trailing @ in +;; an ls -alF listing, you need to (setq dired-ls-F-marks-symlinks t). +;; Most UNIX systems do not do this, but ULTRIX does. If you think that +;; there is a chance you might connect to an ULTRIX machine (such as +;; prep.ai.mit.edu), then set this variable accordingly. This will have +;; the side effect that dired will have problems with symlinks whose names +;; end in an @. If you get yourself into this situation then editing +;; dired's ls-switches to remove "F", will temporarily fix things. +;; +;; 2. If you know that you are connecting to a certain non-UNIX machine +;; frequently, and ange-ftp seems to be unable to guess its host-type, +;; then setting the appropriate host-type regexp +;; (ange-ftp-vms-host-regexp, ange-ftp-mts-host-regexp, or +;; ange-ftp-cms-host-regexp) accordingly should help. Also, please report +;; ange-ftp's inability to recognize the host-type as a bug. +;; +;; 3. For slow connections, you might get "listing unreadable" error +;; messages, or get an empty buffer for a file that you know has something +;; in it. The solution is to increase the value of ange-ftp-retry-time. +;; Its default value is 5 which is plenty for reasonable connections. +;; However, for some transatlantic connections I set this to 20. +;; +;; 4. Beware of compressing files on non-UNIX hosts. Ange-ftp will do it by +;; copying the file to the local machine, compressing it there, and then +;; sending it back. Binary file transfers between machines of different +;; architectures can be a risky business. Test things out first on some +;; test files. See "Bugs" below. Also, note that ange-ftp copies files by +;; moving them through the local machine. Again, be careful when doing +;; this with binary files on non-Unix machines. +;; +;; 5. Beware that dired over ftp will use your setting of dired-no-confirm +;; (list of dired commands for which confirmation is not asked). You +;; might want to reconsider your setting of this variable, because you +;; might want confirmation for more commands on remote direds than on +;; local direds. For example, I strongly recommend that you not include +;; compress and uncompress in this list. If there is enough demand it +;; might be a good idea to have an alist ange-ftp-dired-no-confirm of +;; pairs ( TYPE . LIST ), where TYPE is an operating system type and LIST +;; is a list of commands for which confirmation would be suppressed. Then +;; remote dired listings would take their (buffer-local) value of +;; dired-no-confirm from this alist. Who votes for this? + +;; --------------------------------------------------------------------- +;; Non-UNIX support: +;; --------------------------------------------------------------------- + +;; VMS support: +;; +;; Ange-ftp has full support for VMS hosts. It +;; should be able to automatically recognize any VMS machine. However, if it +;; fails to do this, you can use the command ange-ftp-add-vms-host. As well, +;; you can set the variable ange-ftp-vms-host-regexp in your .emacs file. We +;; would be grateful if you would report any failures to automatically +;; recognize a VMS host as a bug. +;; +;; Filename Syntax: +;; +;; For ease of *implementation*, the user enters the VMS filename syntax in a +;; UNIX-y way. For example: +;; PUB$:[ANONYMOUS.SDSCPUB.NEXT]README.TXT;1 +;; would be entered as: +;; /PUB$$:/ANONYMOUS/SDSCPUB/NEXT/README.TXT;1 +;; i.e. to log in as anonymous on ymir.claremont.edu and grab the file: +;; [.CSV.POLICY]RULES.MEM +;; you would type: +;; C-x C-f /anonymous@ymir.claremont.edu:CSV/POLICY/RULES.MEM +;; +;; A legal VMS filename is of the form: FILE.TYPE;## +;; where FILE can be up to 39 characters +;; TYPE can be up to 39 characters +;; ## is a version number (an integer between 1 and 32,767) +;; Valid characters in FILE and TYPE are A-Z 0-9 _ - $ +;; $ cannot begin a filename, and - cannot be used as the first or last +;; character. +;; +;; Tips: +;; 1. Although VMS is not case sensitive, EMACS running under UNIX is. +;; Therefore, to access a VMS file, you must enter the filename with upper +;; case letters. +;; 2. To access the latest version of file under VMS, you use the filename +;; without the ";" and version number. You should always edit the latest +;; version of a file. If you want to edit an earlier version, copy it to a +;; new file first. This has nothing to do with ange-ftp, but is simply +;; good VMS operating practice. Therefore, to edit FILE.TXT;3 (say 3 is +;; latest version), do C-x C-f /ymir.claremont.edu:FILE.TXT. If you +;; inadvertently do C-x C-f /ymir.claremont.edu:FILE.TXT;3, you will find +;; that VMS will not allow you to save the file because it will refuse to +;; overwrite FILE.TXT;3, but instead will want to create FILE.TXT;4, and +;; attach the buffer to this file. To get out of this situation, M-x +;; write-file /ymir.claremont.edu:FILE.TXT will attach the buffer to +;; latest version of the file. For this reason, in dired "f" +;; (dired-find-file), always loads the file sans version, whereas "v", +;; (dired-view-file), always loads the explicit version number. The +;; reasoning being that it reasonable to view old versions of a file, but +;; not to edit them. +;; 3. EMACS has a feature in which it does environment variable substitution +;; in filenames. Therefore, to enter a $ in a filename, you must quote it +;; by typing $$. + +;; MTS support: +;; +;; Ange-ftp has full support for hosts running +;; the Michigan terminal system. It should be able to automatically +;; recognize any MTS machine. However, if it fails to do this, you can use +;; the command ange-ftp-add-mts-host. As well, you can set the variable +;; ange-ftp-mts-host-regexp in your .emacs file. We would be grateful if you +;; would report any failures to automatically recognize a MTS host as a bug. +;; +;; Filename syntax: +;; +;; MTS filenames are entered in a UNIX-y way. For example, if your account +;; was YYYY, the file FILE in the account XXXX: on mtsg.ubc.ca would be +;; entered as +;; /YYYY@mtsg.ubc.ca:/XXXX:/FILE +;; In other words, MTS accounts are treated as UNIX directories. Of course, +;; to access a file in another account, you must have access permission for +;; it. If FILE were in your own account, then you could enter it in a +;; relative name fashion as +;; /YYYY@mtsg.ubc.ca:FILE +;; MTS filenames can be up to 12 characters. Like UNIX, the structure of the +;; filename does not contain a TYPE (i.e. it can have as many "."'s as you +;; like.) MTS filenames are always in upper case, and hence be sure to enter +;; them as such! MTS is not case sensitive, but an EMACS running under UNIX +;; is. + +;; CMS support: +;; +;; Ange-ftp has full support for hosts running +;; CMS. It should be able to automatically recognize any CMS machine. +;; However, if it fails to do this, you can use the command +;; ange-ftp-add-cms-host. As well, you can set the variable +;; ange-ftp-cms-host-regexp in your .emacs file. We would be grateful if you +;; would report any failures to automatically recognize a CMS host as a bug. +;; +;; Filename syntax: +;; +;; CMS filenames are entered in a UNIX-y way. In otherwords, minidisks are +;; treated as UNIX directories. For example to access the file READ.ME in +;; minidisk *.311 on cuvmb.cc.columbia.edu, you would enter +;; /anonymous@cuvmb.cc.columbia.edu:/*.311/READ.ME +;; If *.301 is the default minidisk for this account, you could access +;; FOO.BAR on this minidisk as +;; /anonymous@cuvmb.cc.columbia.edu:FOO.BAR +;; CMS filenames are of the form FILE.TYPE, where both FILE and TYPE can be +;; up to 8 characters. Again, beware that CMS filenames are always upper +;; case, and hence must be entered as such. +;; +;; Tips: +;; 1. CMS machines, with the exception of anonymous accounts, nearly always +;; need an account password. To have ange-ftp send an account password, +;; you can either include it in your .netrc file, or use +;; ange-ftp-set-account. +;; 2. Ange-ftp cannot send "write passwords" for a minidisk. Hopefully, we +;; can fix this. +;; +;; ------------------------------------------------------------------ +;; Bugs: +;; ------------------------------------------------------------------ +;; +;; 1. Umask problems: +;; Be warned that files created by using ange-ftp will take account of the +;; umask of the ftp daemon process rather than the umask of the creating +;; user. This is particularly important when logging in as the root user. +;; The way that I tighten up the ftp daemon's umask under HP-UX is to make +;; sure that the umask is changed to 027 before I spawn /etc/inetd. I +;; suspect that there is something similar on other systems. +;; +;; 2. Some combinations of FTP clients and servers break and get out of sync +;; when asked to list a non-existent directory. Some of the ai.mit.edu +;; machines cause this problem for some FTP clients. Using +;; ange-ftp-kill-ftp-process can restart the ftp process, which +;; should get things back in sync. +;; +;; 3. Ange-ftp does not check to make sure that when creating a new file, +;; you provide a valid filename for the remote operating system. +;; If you do not, then the remote FTP server will most likely +;; translate your filename in some way. This may cause ange-ftp to +;; get confused about what exactly is the name of the file. The +;; most common causes of this are using lower case filenames on systems +;; which support only upper case, and using filenames which are too +;; long. +;; +;; 4. Null (blank) passwords confuse both ange-ftp and some FTP daemons. +;; +;; 5. Ange-ftp likes to use pty's to talk to its FTP processes. If GNU Emacs +;; for some reason creates a FTP process that only talks via pipes then +;; ange-ftp won't be getting the information it requires at the time that +;; it wants it since pipes flush at different times to pty's. One +;; disgusting way around this problem is to talk to the FTP process via +;; rlogin which does the 'right' things with pty's. +;; +;; 6. For CMS support, we send too many cd's. Since cd's are cheap, I haven't +;; worried about this too much. Eventually, we should have some caching +;; of the current minidisk. +;; +;; 7. Some CMS machines do not assign a default minidisk when you ftp them as +;; anonymous. It is then necessary to guess a valid minidisk name, and cd +;; to it. This is (understandably) beyond ange-ftp. +;; +;; 8. Remote to remote copying of files on non-Unix machines can be risky. +;; Depending on the variable ange-ftp-binary-file-name-regexp, ange-ftp +;; will use binary mode for the copy. Between systems of different +;; architecture, this still may not be enough to guarantee the integrity +;; of binary files. Binary file transfers from VMS machines are +;; particularly problematical. Should ange-ftp-binary-file-name-regexp be +;; an alist of OS type, regexp pairs? +;; +;; 9. The code to do compression of files over ftp is not as careful as it +;; should be. It deletes the old remote version of the file, before +;; actually checking if the local to remote transfer of the compressed +;; file succeeds. Of course to delete the original version of the file +;; after transferring the compressed version back is also dangerous, +;; because some OS's have severe restrictions on the length of filenames, +;; and when the compressed version is copied back the "-Z" or ".Z" may be +;; truncated. Then, ange-ftp would delete the only remaining version of +;; the file. Maybe ange-ftp should make backups when it compresses files +;; (of course, the backup "~" could also be truncated off, sigh...). +;; Suggestions? +;; +;; 10. If a dir listing is attempted for an empty directory on (at least +;; some) VMS hosts, an ftp error is given. This is really an ftp bug, and +;; I don't know how to get ange-ftp work to around it. +;; +;; 11. Bombs on filenames that start with a space. Deals well with filenames +;; containing spaces, but beware that the remote ftpd may not like them +;; much. +;; +;; 12. The dired support for non-Unix-like systems does not currently work. +;; It needs to be reimplemented by modifying the parse-...-listing +;; functions to convert the directory listing to ls -l format. +;; +;; 13. The famous @ bug. As mentioned above in TIPS, ULTRIX marks symlinks +;; with a trailing @ in a ls -alF listing. In order to account for this +;; ange-ftp looks to chop trailing @'s off of symlink names when it is +;; parsing a listing with the F switch. This will cause ange-ftp to +;; incorrectly get the name of a symlink on a non-ULTRIX host if its name +;; ends in an @. ange-ftp will correct itself if you take F out of the +;; dired ls switches (C-u s will allow you to edit the switches). The +;; dired buffer will be automatically reverted, which will allow ange-ftp +;; to fix its files hashtable. A cookie to anyone who can think of a +;; fast, sure-fire way to recognize ULTRIX over ftp. + +;; If you find any bugs or problems with this package, PLEASE either e-mail +;; the above author, or send a message to the ange-ftp-lovers mailing list +;; below. Ideas and constructive comments are especially welcome. + +;; ange-ftp-lovers: +;; +;; ange-ftp has its own mailing list modestly called ange-ftp-lovers. All +;; users of ange-ftp are welcome to subscribe (see below) and to discuss +;; aspects of ange-ftp. New versions of ange-ftp are posted periodically to +;; the mailing list. +;; +;; To [un]subscribe to ange-ftp-lovers, or to report mailer problems with the +;; list, please mail one of the following addresses: +;; +;; ange-ftp-lovers-request@anorman.hpl.hp.com +;; or +;; ange-ftp-lovers-request%anorman.hpl.hp.com@hplb.hpl.hp.com +;; +;; Please don't forget the -request part. +;; +;; For mail to be posted directly to ange-ftp-lovers, send to one of the +;; following addresses: +;; +;; ange-ftp-lovers@anorman.hpl.hp.com +;; or +;; ange-ftp-lovers%anorman.hpl.hp.com@hplb.hpl.hp.com +;; +;; Alternatively, there is a mailing list that only gets announcements of new +;; ange-ftp releases. This is called ange-ftp-lovers-announce, and can be +;; subscribed to by e-mailing to the -request address as above. Please make +;; it clear in the request which mailing list you wish to join. + +;; The latest version of ange-ftp can usually be obtained via anonymous ftp +;; from: +;; alpha.gnu.ai.mit.edu:ange-ftp/ange-ftp.tar.Z +;; or: +;; ugle.unit.no:/pub/gnu/emacs-lisp/ange-ftp.tar.Z +;; or: +;; archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/packages/ange-ftp.tar.Z + +;; The archives for ange-ftp-lovers can be found via anonymous ftp under: +;; +;; ftp.reed.edu:pub/mailing-lists/ange-ftp/ -;;; ----------------------------------------------------------- -;;; Technical information on this package: -;;; ----------------------------------------------------------- - -;;; ange-ftp works by putting a handler on file-name-handler-alist -;;; which is called by many primitives, and a few non-primitives, -;;; whenever they see a file name of the appropriate sort. - -;;; Checklist for adding non-UNIX support for TYPE -;;; -;;; The following functions may need TYPE versions: -;;; (not all functions will be needed for every OS) -;;; -;;; ange-ftp-fix-name-for-TYPE -;;; ange-ftp-fix-dir-name-for-TYPE -;;; ange-ftp-TYPE-host -;;; ange-ftp-TYPE-add-host -;;; ange-ftp-parse-TYPE-listing -;;; ange-ftp-TYPE-delete-file-entry -;;; ange-ftp-TYPE-add-file-entry -;;; ange-ftp-TYPE-file-name-as-directory -;;; ange-ftp-TYPE-make-compressed-filename -;;; ange-ftp-TYPE-file-name-sans-versions -;;; -;;; Variables: -;;; -;;; ange-ftp-TYPE-host-regexp -;;; May need to add TYPE to ange-ftp-dumb-host-types -;;; -;;; Check the following functions for OS dependent coding: -;;; -;;; ange-ftp-host-type -;;; ange-ftp-guess-host-type -;;; ange-ftp-allow-child-lookup - -;;; Host type conventions: -;;; -;;; The function ange-ftp-host-type and the variable ange-ftp-dired-host-type -;;; (mostly) follow the following conventions for remote host types. At -;;; least, I think that future code should try to follow these conventions, -;;; and the current code should eventually be made compliant. -;;; -;;; nil = local host type, whatever that is (probably unix). -;;; Think nil as in "not a remote host". This value is used by -;;; ange-ftp-dired-host-type for local buffers. -;;; -;;; t = a remote host of unknown type. Think t is in true, it's remote. -;;; Currently, 'unix is used as the default remote host type. -;;; Maybe we should use t. -;;; -;;; 'type = a remote host of TYPE type. -;;; -;;; 'type:list = a remote host of TYPE type, using a specialized ftp listing -;;; program called list. This is currently only used for Unix -;;; dl (descriptive listings), when ange-ftp-dired-host-type -;;; is set to 'unix:dl. - -;;; Bug report codes: -;;; -;;; Because of their naive faith in this code, there are certain situations -;;; which the writers of this program believe could never happen. However, -;;; being realists they have put calls to `error' in the program at these -;;; points. These errors provide a code, which is an integer, greater than 1. -;;; To aid debugging. the error codes, and the functions in which they reside -;;; are listed below. -;;; -;;; 1: See ange-ftp-ls -;;; +;; ----------------------------------------------------------- +;; Technical information on this package: +;; ----------------------------------------------------------- + +;; ange-ftp works by putting a handler on file-name-handler-alist +;; which is called by many primitives, and a few non-primitives, +;; whenever they see a file name of the appropriate sort. + +;; Checklist for adding non-UNIX support for TYPE +;; +;; The following functions may need TYPE versions: +;; (not all functions will be needed for every OS) +;; +;; ange-ftp-fix-name-for-TYPE +;; ange-ftp-fix-dir-name-for-TYPE +;; ange-ftp-TYPE-host +;; ange-ftp-TYPE-add-host +;; ange-ftp-parse-TYPE-listing +;; ange-ftp-TYPE-delete-file-entry +;; ange-ftp-TYPE-add-file-entry +;; ange-ftp-TYPE-file-name-as-directory +;; ange-ftp-TYPE-make-compressed-filename +;; ange-ftp-TYPE-file-name-sans-versions +;; +;; Variables: +;; +;; ange-ftp-TYPE-host-regexp +;; May need to add TYPE to ange-ftp-dumb-host-types +;; +;; Check the following functions for OS dependent coding: +;; +;; ange-ftp-host-type +;; ange-ftp-guess-host-type +;; ange-ftp-allow-child-lookup + +;; Host type conventions: +;; +;; The function ange-ftp-host-type and the variable ange-ftp-dired-host-type +;; (mostly) follow the following conventions for remote host types. At +;; least, I think that future code should try to follow these conventions, +;; and the current code should eventually be made compliant. +;; +;; nil = local host type, whatever that is (probably unix). +;; Think nil as in "not a remote host". This value is used by +;; ange-ftp-dired-host-type for local buffers. +;; +;; t = a remote host of unknown type. Think t is in true, it's remote. +;; Currently, 'unix is used as the default remote host type. +;; Maybe we should use t. +;; +;; 'type = a remote host of TYPE type. +;; +;; 'type:list = a remote host of TYPE type, using a specialized ftp listing +;; program called list. This is currently only used for Unix +;; dl (descriptive listings), when ange-ftp-dired-host-type +;; is set to 'unix:dl. + +;; Bug report codes: +;; +;; Because of their naive faith in this code, there are certain situations +;; which the writers of this program believe could never happen. However, +;; being realists they have put calls to `error' in the program at these +;; points. These errors provide a code, which is an integer, greater than 1. +;; To aid debugging. the error codes, and the functions in which they reside +;; are listed below. +;; +;; 1: See ange-ftp-ls +;; -;;; ----------------------------------------------------------- -;;; Hall of fame: -;;; ----------------------------------------------------------- -;;; -;;; Thanks to Roland McGrath for improving the filename syntax handling, -;;; for suggesting many enhancements and for numerous cleanups to the code. -;;; -;;; Thanks to Jamie Zawinski for bugfixes and for ideas such as gateways. -;;; -;;; Thanks to Ken Laprade for improved .netrc parsing, password reading, and -;;; dired / shell auto-loading. -;;; -;;; Thanks to Sebastian Kremer for dired support and for many ideas and -;;; bugfixes. -;;; -;;; Thanks to Joe Wells for bugfixes, the original non-UNIX system support, -;;; VOS support, and hostname completion. -;;; -;;; Thanks to Nakagawa Takayuki for many good ideas, filename-completion, help -;;; with file-name expansion, efficiency worries, stylistic concerns and many -;;; bugfixes. -;;; -;;; Thanks to Sandy Rutherford who re-wrote most of ange-ftp to support VMS, -;;; MTS, CMS and UNIX-dls. Sandy also added dired-support for non-UNIX OS and -;;; auto-recognition of the host type. -;;; -;;; Thanks to Dave Smith who wrote the info file for ange-ftp. -;;; -;;; Finally, thanks to Keith Waclena, Mark D. Baushke, Terence Kelleher, Ping -;;; Zhou, Edward Vielmetti, Jack Repenning, Mike Balenger, Todd Kaufmann, -;;; Kjetil Svarstad, Tom Wurgler, Linus Tolke, Niko Makila, Carl Edman, Bill -;;; Trost, Dave Brennan, Dan Jacobson, Andy Scott, Steve Anderson, Sanjay -;;; Mathur, the folks on the ange-ftp-lovers mailing list and many others -;;; whose names I've forgotten who have helped to debug and fix problems with -;;; ange-ftp.el. +;; ----------------------------------------------------------- +;; Hall of fame: +;; ----------------------------------------------------------- +;; +;; Thanks to Roland McGrath for improving the filename syntax handling, +;; for suggesting many enhancements and for numerous cleanups to the code. +;; +;; Thanks to Jamie Zawinski for bugfixes and for ideas such as gateways. +;; +;; Thanks to Ken Laprade for improved .netrc parsing, password reading, and +;; dired / shell auto-loading. +;; +;; Thanks to Sebastian Kremer for dired support and for many ideas and +;; bugfixes. +;; +;; Thanks to Joe Wells for bugfixes, the original non-UNIX system support, +;; VOS support, and hostname completion. +;; +;; Thanks to Nakagawa Takayuki for many good ideas, filename-completion, help +;; with file-name expansion, efficiency worries, stylistic concerns and many +;; bugfixes. +;; +;; Thanks to Sandy Rutherford who re-wrote most of ange-ftp to support VMS, +;; MTS, CMS and UNIX-dls. Sandy also added dired-support for non-UNIX OS and +;; auto-recognition of the host type. +;; +;; Thanks to Dave Smith who wrote the info file for ange-ftp. +;; +;; Finally, thanks to Keith Waclena, Mark D. Baushke, Terence Kelleher, Ping +;; Zhou, Edward Vielmetti, Jack Repenning, Mike Balenger, Todd Kaufmann, +;; Kjetil Svarstad, Tom Wurgler, Linus Tolke, Niko Makila, Carl Edman, Bill +;; Trost, Dave Brennan, Dan Jacobson, Andy Scott, Steve Anderson, Sanjay +;; Mathur, the folks on the ange-ftp-lovers mailing list and many others +;; whose names I've forgotten who have helped to debug and fix problems with +;; ange-ftp.el. - ;;; Code: + (require 'comint) ;;;; ------------------------------------------------------------ @@ -618,7 +627,7 @@ ;;;; ------------------------------------------------------------ (defvar ange-ftp-name-format - '("^/\\(\\([^@/:]*\\)@\\)?\\([^@/:]*\\):\\(.*\\)" . (3 2 4)) + '("^/\\(\\([^@/:]*\\)@\\)?\\([^@/:]*[^@/:.]\\):\\(.*\\)" . (3 2 4)) "*Format of a fully expanded remote file name. This is a list of the form \(REGEXP HOST USER NAME\), where REGEXP is a regular expression matching @@ -631,13 +640,11 @@ parenthesized expressions in REGEXP for the components (in that order).") (defvar ange-ftp-multi-msgs "^220-\\|^230-\\|^226\\|^25.-\\|^221-\\|^200-\\|^331-\\|^4[25]1-\\|^530-" - "*Regular expression matching messages from the ftp process that start -a multiline reply.") + "*Regular expression matching the start of a multiline ftp reply.") (defvar ange-ftp-good-msgs "^220 \\|^230 \\|^226 \\|^25. \\|^221 \\|^200 \\|^[Hh]ash mark" - "*Regular expression matching messages from the ftp process that indicate -that the action that was initiated has completed successfully.") + "*Regular expression matching ftp \"success\" messages.") ;; CMS and the odd VMS machine say 200 Port rather than 200 PORT. ;; Also CMS machines use a multiline 550- reply to say that you @@ -648,21 +655,19 @@ that the action that was initiated has completed successfully.") (defvar ange-ftp-skip-msgs (concat "^200 \\(PORT\\|Port\\) \\|^331 \\|^150 \\|^350 \\|^[0-9]+ bytes \\|" "^Connected \\|^$\\|^Remote system\\|^Using\\|^ \\|Password:\\|" + "^Data connection \\|" "^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye") - "*Regular expression matching messages from the ftp process that can be -ignored.") + "*Regular expression matching ftp messages that can be ignored.") (defvar ange-ftp-fatal-msgs (concat "^ftp: \\|^Not connected\\|^530 \\|^4[25]1 \\|rcmd: \\|" "^No control connection\\|unknown host\\|^lost connection") - "*Regular expression matching messages from the FTP process that indicate -something has gone drastically wrong attempting the action that was -initiated and that the FTP process should (or already has) been killed.") + "*Regular expression matching ftp messages that indicate serious errors. +These mean that the FTP process should (or already has) been killed.") (defvar ange-ftp-gateway-fatal-msgs "No route to host\\|Connection closed\\|No such host\\|Login incorrect" - "*Regular expression matching messages from the rlogin / telnet process that -indicates that logging in to the gateway machine has gone wrong.") + "*Regular expression matching login failure messages from rlogin/telnet.") (defvar ange-ftp-xfer-size-msgs "^150 .* connection for .* (\\([0-9]+\\) bytes)" @@ -685,52 +690,69 @@ cross-mounted.") "*If non-nil avoid checking permissions on the .netrc file.") (defvar ange-ftp-default-user nil - "*User name to use when none is specied in a file name. -If nil, then the name under which the user is logged in is used. -If non-nil but not a string, the user is prompted for the name.") + "*User name to use when none is specified in a file name. +If non-nil but not a string, you are prompted for the name. +If nil, the value of `ange-ftp-netrc-default-user' is used. +If that is nil too, then your login name is used. + +Once a connection to a given host has been initiated, the user name +and password information for that host are cached and re-used by +ange-ftp. Use `ange-ftp-set-user' to change the cached values, +since setting `ange-ftp-default-user' directly does not affect +the cached information.") + +(defvar ange-ftp-netrc-default-user nil + "Alternate default user name to use when none is specified. +This variable is set from the `default' command in your `.netrc' file, +if there is one.") (defvar ange-ftp-default-password nil - "*Password to use when the user is the same as ange-ftp-default-user.") + "*Password to use when the user name equals `ange-ftp-default-user'.") (defvar ange-ftp-default-account nil - "*Account password to use when the user is the same as ange-ftp-default-user.") + "*Account to use when the user name equals `ange-ftp-default-user'.") + +(defvar ange-ftp-netrc-default-password nil + "*Password to use when the user name equals `ange-ftp-netrc-default-user'.") + +(defvar ange-ftp-netrc-default-account nil + "*Account to use when the user name equals `ange-ftp-netrc-default-user'.") (defvar ange-ftp-generate-anonymous-password t - "*If t, use a password of user@host when logging in as the anonymous user. -If a string then use that as the password. -If nil then prompt the user for a password.") + "*If t, use value of `user-mail-address' as password for anonymous ftp. +If a string, then use that string as the password. +If nil, prompt the user for a password.") (defvar ange-ftp-dumb-unix-host-regexp nil - "*If non-nil, if the host being ftp'd to matches this regexp then the FTP -process uses the \'dir\' command to get directory information.") + "*If non-nil, regexp matching hosts on which `dir' command lists directory.") (defvar ange-ftp-binary-file-name-regexp (concat "\\.[zZ]$\\|\\.lzh$\\|\\.arc$\\|\\.zip$\\|\\.zoo$\\|\\.tar$\\|" "\\.dvi$\\|\\.ps$\\|\\.elc$\\|TAGS$\\|\\.gif$\\|" - "\\.EXE\\(;[0-9]+\\)?$\\|\\.[zZ]-part-..$\\|\\.gz$") + "\\.EXE\\(;[0-9]+\\)?$\\|\\.[zZ]-part-..$\\|\\.gz$\\|" + "\\.taz$\\|\\.tgz$") "*If a file matches this regexp then it is transferred in binary mode.") (defvar ange-ftp-gateway-host nil "*Name of host to use as gateway machine when local FTP isn't possible.") (defvar ange-ftp-local-host-regexp ".*" - "*If a host being FTP'd to matches this regexp then the ftp process is started -locally, otherwise the FTP process is started on \`ange-ftp-gateway-host\' -instead.") + "*Regexp selecting hosts which can be reached directly with ftp. +For other hosts the FTP process is started on \`ange-ftp-gateway-host\' +instead, and/or reached via \`ange-ftp-gateway-ftp-program-name\'.") (defvar ange-ftp-gateway-program-interactive nil - "*If non-nil then the gateway program is expected to connect to the gateway -machine and eventually give a shell prompt. Both telnet and rlogin do something -like this.") - -(defvar ange-ftp-gateway-program (if (eq system-type 'hpux) "remsh" "rsh") - "*Name of program to spawn a shell on the gateway machine. Valid candidates -are rsh (remsh on hp-ux), telnet and rlogin. See also the gateway variable -above.") - -(defvar ange-ftp-gateway-prompt-pattern "^[^#$%>;]*[#$%>;] *" - "*Regexp used to detect that the logging-in sequence is completed on the -gateway machine and that the shell is now awaiting input. Make this regexp as + "*If non-nil then the gateway program should give a shell prompt. +Both telnet and rlogin do something like this.") + +(defvar ange-ftp-gateway-program remote-shell-program + "*Name of program to spawn a shell on the gateway machine. +Valid candidates are rsh (remsh on some systems), telnet and rlogin. See +also the gateway variable above.") + +(defvar ange-ftp-gateway-prompt-pattern "^[^#$%>;\n]*[#$%>;] *" + "*Regexp matching prompt after complete login sequence on gateway machine. +A match for this means the shell is now awaiting input. Make this regexp as strict as possible; it shouldn't match *anything* at all except the user's initial prompt. The above string will fail under most SUN-3's since it matches the login banner.") @@ -739,12 +761,14 @@ matches the login banner.") (if (eq system-type 'hpux) "stty -onlcr -echo\n" "stty -echo nl\n") - "*Command to use after logging in to the gateway machine to stop the terminal -echoing each command and to strip out trailing ^M characters.") + "*Set up terminal after logging in to the gateway machine. +This command should stop the terminal from echoing each command, and +arrange to strip out trailing ^M characters.") (defvar ange-ftp-smart-gateway nil - "*If the gateway FTP is smart enough to use proxy server, then don't bother -telnetting etc, just issue a user@host command instead.") + "*Non-nil means the ftp gateway and/or the gateway ftp program is smart. +Don't bother telnetting, etc., already connected to desired host transparently, +or just issue a user@host command in case \`ange-ftp-gateway-host\' is non-nil.") (defvar ange-ftp-smart-gateway-port "21" "*Port on gateway machine to use when smart gateway is in operation.") @@ -770,7 +794,7 @@ outputs a suitable response to the HASH command.") "*Name of FTP program to run.") (defvar ange-ftp-gateway-ftp-program-name "ftp" - "*Name of FTP program to run on gateway machine. + "*Name of FTP program to run when accessing non-local hosts. Some AT&T folks claim to use something called `pftp' here.") (defvar ange-ftp-ftp-program-args '("-i" "-n" "-g" "-v") @@ -783,8 +807,8 @@ Some AT&T folks claim to use something called `pftp' here.") "*Non-nil means make backup files for \"magic\" remote files.") (defvar ange-ftp-retry-time 5 - "*Number of seconds to wait before retrying if a file or listing -doesn't arrive. This might need to be increased for very slow connections.") + "*Number of seconds to wait before retry if file or listing doesn't arrive. +This might need to be increased for very slow connections.") (defvar ange-ftp-auto-save 0 "If 1, allows ange-ftp files to be auto-saved. @@ -856,8 +880,6 @@ SIZE, if supplied, should be a prime number." ;;;; Internal variables. ;;;; ------------------------------------------------------------ -(defconst ange-ftp-version "$Revision: 1.26 $") - (defvar ange-ftp-data-buffer-name " *ftp data*" "Buffer name to hold directory listing data received from ftp process.") @@ -916,24 +938,6 @@ SIZE, if supplied, should be a prime number." (put 'ftp-error 'error-conditions '(ftp-error file-error error)) ;; (put 'ftp-error 'error-message "FTP error") -;;; ------------------------------------------------------------ -;;; Match-data support (stolen from Kyle I think) -;;; ------------------------------------------------------------ - -(defmacro ange-ftp-save-match-data (&rest body) - "Execute the BODY forms, restoring the global value of the match data. -Also makes matching case-sensitive within BODY." - (let ((original (make-symbol "match-data")) - case-fold-search) - (list - 'let (list (list original '(match-data))) - (list 'unwind-protect - (cons 'progn body) - (list 'store-match-data original))))) - -(put 'ange-ftp-save-match-data 'lisp-indent-hook 0) -(put 'ange-ftp-save-match-data 'edebug-form-hook '(&rest form)) - ;;; ------------------------------------------------------------ ;;; Enhanced message support. ;;; ------------------------------------------------------------ @@ -943,15 +947,18 @@ Also makes matching case-sensitive within BODY." Args are as in `message': a format string, plus arguments to be formatted." (let ((msg (apply (function format) fmt args)) (max (window-width (minibuffer-window)))) - (if (>= (length msg) max) - (setq msg (concat "> " (substring msg (- 3 max))))) - (message "%s" msg))) + (if noninteractive + msg + (if (>= (length msg) max) + ;; Take just the last MAX - 3 chars of the string. + (setq msg (concat "> " (substring msg (- 3 max))))) + (message "%s" msg)))) (defun ange-ftp-abbreviate-filename (file &optional new) "Abbreviate the file name FILE relative to the default-directory. If the optional parameter NEW is given and the non-directory parts match, only return the directory part of FILE." - (ange-ftp-save-match-data + (save-match-data (if (and default-directory (string-match (concat "^" (regexp-quote default-directory) @@ -987,6 +994,7 @@ only return the directory part of FILE." (let ((enable-recursive-minibuffers t)) (read-string (format "User for %s: " host) (user-login-name)))) + (ange-ftp-netrc-default-user) ;; Default to the user's login name. (t (user-login-name)))) @@ -1000,7 +1008,7 @@ only return the directory part of FILE." "Read a password, echoing `.' for each character typed. End with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. Optional DEFAULT is password to start with." - (let ((pass (if default default "")) + (let ((pass nil) (c 0) (echo-keystrokes 0) (cursor-in-echo-area t)) @@ -1017,7 +1025,7 @@ Optional DEFAULT is password to start with." (setq pass (substring pass 0 -1)))))) (message "") (ange-ftp-repaint-minibuffer) - pass)) + (or pass default ""))) (defmacro ange-ftp-generate-passwd-key (host user) (` (concat (, host) "/" (, user)))) @@ -1044,7 +1052,7 @@ Optional DEFAULT is password to start with." (if (ange-ftp-lookup-passwd host user) (throw 'found-one host)))) ange-ftp-user-hashtable) - (ange-ftp-save-match-data + (save-match-data (ange-ftp-map-hashtable (function (lambda (key value) @@ -1064,12 +1072,18 @@ Optional DEFAULT is password to start with." ;; defaults. (cond ((ange-ftp-lookup-passwd host user)) - ;; see if default user and password set from the .netrc file. + ;; See if default user and password set. ((and (stringp ange-ftp-default-user) ange-ftp-default-password (string-equal user ange-ftp-default-user)) ange-ftp-default-password) + ;; See if default user and password set from .netrc file. + ((and (stringp ange-ftp-netrc-default-user) + ange-ftp-netrc-default-password + (string-equal user ange-ftp-netrc-default-user)) + ange-ftp-netrc-default-password) + ;; anonymous ftp password is handled specially since there is an ;; unwritten rule about how that is used on the Internet. ((and (or (string-equal user "anonymous") @@ -1077,7 +1091,7 @@ Optional DEFAULT is password to start with." ange-ftp-generate-anonymous-password) (if (stringp ange-ftp-generate-anonymous-password) ange-ftp-generate-anonymous-password - (concat (user-login-name) "@" (system-name)))) + user-mail-address)) ;; see if same user has logged in to other hosts; if so then prompt ;; with the password that was used there. @@ -1088,7 +1102,7 @@ Optional DEFAULT is password to start with." ;; found another machine with the same user. ;; Try that account. (ange-ftp-read-passwd - (format "passwd for %s@%s (same as %s@%s): " + (format "passwd for %s@%s (default same as %s@%s): " user host user other) (ange-ftp-lookup-passwd other user)) @@ -1123,7 +1137,10 @@ Optional DEFAULT is password to start with." ange-ftp-account-hashtable) (and (stringp ange-ftp-default-user) (string-equal user ange-ftp-default-user) - ange-ftp-default-account))) + ange-ftp-default-account) + (and (stringp ange-ftp-netrc-default-user) + (string-equal user ange-ftp-netrc-default-user) + ange-ftp-netrc-default-account))) ;;;; ------------------------------------------------------------ ;;;; ~/.netrc support @@ -1139,10 +1156,11 @@ Optional DEFAULT is password to start with." (concat (file-name-directory file) temp))))) file) +;; Move along current line looking for the value of the TOKEN. +;; Valid separators between TOKEN and its value are commas and +;; whitespace. Second arg LIMIT is a limit for the search. + (defun ange-ftp-parse-netrc-token (token limit) - "Move along current line looking for the value of the TOKEN. -Valid separators between TOKEN and its value are commas and -whitespace. Second arg LIMIT is a limit for the search." (if (search-forward token limit t) (let (beg) (skip-chars-forward ", \t\r\n" limit) @@ -1156,16 +1174,27 @@ whitespace. Second arg LIMIT is a limit for the search." (skip-chars-forward "^, \t\r\n" limit) (buffer-substring beg (point)))))) +;; Extract the values for the tokens `machine', `login', +;; `password' and `account' in the current buffer. If successful, +;; record the information found. + (defun ange-ftp-parse-netrc-group () - "Extract the values for the tokens \`machine\', \`login\', \`password\' -and \`account\' in the current buffer. If successful, record the information -found." - (beginning-of-line) (let ((start (point)) - (end (progn (re-search-forward "machine\\|default" - (point-max) 'end 2) (point))) + (end (save-excursion + (if (looking-at "machine\\>") + ;; Skip `machine' and the machine name that follows. + (progn + (skip-chars-forward "^ \t\n") + (skip-chars-forward " \t\n") + (skip-chars-forward "^ \t\n")) + ;; Skip `default'. + (skip-chars-forward "^ \t\n")) + ;; Find start of the next `machine' or `default' + ;; or the end of the buffer. + (if (re-search-forward "machine\\>\\|default\\>" nil t) + (match-beginning 0) + (point-max)))) machine login password account) - (goto-char start) (setq machine (ange-ftp-parse-netrc-token "machine" end) login (ange-ftp-parse-netrc-token "login" end) password (ange-ftp-parse-netrc-token "password" end) @@ -1185,27 +1214,29 @@ found." password (ange-ftp-parse-netrc-token "password" end) account (ange-ftp-parse-netrc-token "account" end)) (and login - (setq ange-ftp-default-user login)) + (setq ange-ftp-netrc-default-user login)) (and password - (setq ange-ftp-default-password password)) + (setq ange-ftp-netrc-default-password password)) (and account - (setq ange-ftp-default-account account))))) + (setq ange-ftp-netrc-default-account account))))) (goto-char end))) -(defun ange-ftp-parse-netrc () - "Read in ~/.netrc, if one exists. -If ~/.netrc file exists and has the correct permissions then extract the -\`machine\', \`login\', \`password\' and \`account\' information from within." +;; Read in ~/.netrc, if one exists. If ~/.netrc file exists and has +;; the correct permissions then extract the \`machine\', \`login\', +;; \`password\' and \`account\' information from within. +(defun ange-ftp-parse-netrc () ;; We set this before actually doing it to avoid the possibility ;; of an infinite loop if ange-ftp-netrc-filename is an FTP file. (interactive) - (let* ((file (ange-ftp-chase-symlinks - (ange-ftp-real-expand-file-name ange-ftp-netrc-filename))) - (attr (ange-ftp-real-file-attributes file))) + (let (file attr) + (let ((default-directory "/")) + (setq file (ange-ftp-chase-symlinks + (ange-ftp-real-expand-file-name ange-ftp-netrc-filename))) + (setq attr (ange-ftp-real-file-attributes file))) (if (and attr ; file exists. (not (equal (nth 5 attr) ange-ftp-netrc-modtime))) ; file changed - (ange-ftp-save-match-data + (save-match-data (if (or ange-ftp-disable-netrc-security-check (and (eq (nth 2 attr) (user-uid)) ; Same uids. (string-match ".r..------" (nth 8 attr)))) @@ -1222,6 +1253,7 @@ If ~/.netrc file exists and has the correct permissions then extract the (mapcar 'funcall find-file-hooks) (setq buffer-file-name nil) (goto-char (point-min)) + (skip-chars-forward " \t\n") (while (not (eobp)) (ange-ftp-parse-netrc-group)) (kill-buffer (current-buffer))) @@ -1230,11 +1262,12 @@ If ~/.netrc file exists and has the correct permissions then extract the (sit-for 1)) (setq ange-ftp-netrc-modtime (nth 5 attr)))))) +;; Return a list of prefixes of the form 'user@host:' to be used when +;; completion is done in the root directory. + (defun ange-ftp-generate-root-prefixes () - "Return a list of prefixes of the form 'user@host:' to be used when -completion is done in the root directory." (ange-ftp-parse-netrc) - (ange-ftp-save-match-data + (save-match-data (let (res) (ange-ftp-map-hashtable (function @@ -1265,15 +1298,15 @@ completion is done in the root directory." (defvar ange-ftp-ftp-name-arg "") (defvar ange-ftp-ftp-name-res nil) +;; Parse NAME according to `ange-ftp-name-format' (which see). +;; Returns a list (HOST USER NAME), or nil if NAME does not match the format. (defun ange-ftp-ftp-name (name) - "Parse NAME according to `ange-ftp-name-format' (which see). -Returns a list (HOST USER NAME), or nil if NAME does not match the format." (if (string-equal name ange-ftp-ftp-name-arg) ange-ftp-ftp-name-res (setq ange-ftp-ftp-name-arg name ange-ftp-ftp-name-res - (ange-ftp-save-match-data - (if (string-match (car ange-ftp-name-format) name) + (save-match-data + (if (posix-string-match (car ange-ftp-name-format) name) (let* ((ns (cdr ange-ftp-name-format)) (host (ange-ftp-ftp-name-component 0 ns name)) (user (ange-ftp-ftp-name-component 1 ns name)) @@ -1283,11 +1316,11 @@ Returns a list (HOST USER NAME), or nil if NAME does not match the format." (list host user name)) nil))))) +;; Take a FULLNAME that matches according to ange-ftp-name-format and +;; replace the name component with NAME. (defun ange-ftp-replace-name-component (fullname name) - "Take a FULLNAME that matches according to ange-ftp-name-format and -replace the name component with NAME." - (ange-ftp-save-match-data - (if (string-match (car ange-ftp-name-format) fullname) + (save-match-data + (if (posix-string-match (car ange-ftp-name-format) fullname) (let* ((ns (cdr ange-ftp-name-format)) (elt (nth 2 ns))) (concat (substring fullname 0 (match-beginning elt)) @@ -1305,14 +1338,14 @@ replace the name component with NAME." "Clear any existing minibuffer message; let the minibuffer contents show." (message nil)) +;; Return the name of the buffer that collects output from the ftp process +;; connected to the given HOST and USER pair. (defun ange-ftp-ftp-process-buffer (host user) - "Return the name of the buffer that collects output from the ftp process -connected to the given HOST and USER pair." (concat "*ftp " user "@" host "*")) +;; Display the last chunk of output from the ftp process for the given HOST +;; USER pair, and signal an error including MSG in the text. (defun ange-ftp-error (host user msg) - "Display the last chunk of output from the ftp process for the given HOST -USER pair, and signal an error including MSG in the text." (let ((cur (selected-window)) (pop-up-windows t)) (pop-to-buffer @@ -1326,19 +1359,18 @@ USER pair, and signal an error including MSG in the text." "Set correct modes for the current buffer if visiting a remote file." (if (and (stringp buffer-file-name) (ange-ftp-ftp-name buffer-file-name)) - (progn - (make-local-variable 'make-backup-files) - (setq make-backup-files ange-ftp-make-backup-files) - (auto-save-mode ange-ftp-auto-save)))) + (auto-save-mode ange-ftp-auto-save))) -(defun ange-ftp-kill-ftp-process (buffer) - "Kill the FTP process associated with BUFFER. +(defun ange-ftp-kill-ftp-process (&optional buffer) + "Kill the FTP process associated with BUFFER (the current buffer, if nil). If the BUFFER's visited filename or default-directory is an ftp filename then kill the related ftp process." (interactive "bKill FTP process associated with buffer: ") (if (null buffer) - (setq buffer (current-buffer))) - (let ((file (or (buffer-file-name) default-directory))) + (setq buffer (current-buffer)) + (setq buffer (get-buffer buffer))) + (let ((file (or (buffer-file-name buffer) + (save-excursion (set-buffer buffer) default-directory)))) (if file (let ((parsed (ange-ftp-ftp-name (expand-file-name file)))) (if parsed @@ -1373,8 +1405,9 @@ then kill the related ftp process." ;;;; ------------------------------------------------------------ (defun ange-ftp-process-handle-line (line proc) - "Look at the given LINE from the ftp process PROC. Try to categorize it -into one of four categories: good, skip, fatal, or unknown." + "Look at the given LINE from the ftp process PROC. +Try to categorize it into one of four categories: +good, skip, fatal, or unknown." (cond ((string-match ange-ftp-xfer-size-msgs line) (setq ange-ftp-xfer-size (ash (string-to-int (substring line @@ -1387,34 +1420,23 @@ into one of four categories: good, skip, fatal, or unknown." (setq ange-ftp-process-busy nil ange-ftp-process-result t ange-ftp-process-result-line line)) + ;; Check this before checking for errors. + ;; Otherwise the last line of these three seems to be an error: + ;; 230-see a significant impact from the move. For those of you who can't + ;; 230-use DNS to resolve hostnames and get an error message like + ;; 230-"ftp.stsci.edu: unknown host", the new IP address will be... + ((string-match ange-ftp-multi-msgs line) + (setq ange-ftp-process-multi-skip t)) ((string-match ange-ftp-fatal-msgs line) (delete-process proc) (setq ange-ftp-process-busy nil ange-ftp-process-result-line line)) - ((string-match ange-ftp-multi-msgs line) - (setq ange-ftp-process-multi-skip t)) (ange-ftp-process-multi-skip t) (t (setq ange-ftp-process-busy nil ange-ftp-process-result-line line)))) -(defun ange-ftp-process-log-string (proc str) - "For a given PROCESS, log the given STRING at the end of its -associated buffer." - (let ((old-buffer (current-buffer))) - (unwind-protect - (let (moving) - (set-buffer (process-buffer proc)) - (setq moving (= (point) (process-mark proc))) - (save-excursion - ;; Insert the text, moving the process-marker. - (goto-char (process-mark proc)) - (insert str) - (set-marker (process-mark proc) (point))) - (if moving (goto-char (process-mark proc)))) - (set-buffer old-buffer)))) - (defun ange-ftp-set-xfer-size (host user bytes) "Set the size of the next FTP transfer in bytes." (let ((proc (ange-ftp-get-process host user))) @@ -1432,7 +1454,8 @@ associated buffer." ange-ftp-hash-mark-count (+ (- (match-end 0) (match-beginning 0)) ange-ftp-hash-mark-count)) - (and ange-ftp-process-msg + (and ange-ftp-hash-mark-unit + ange-ftp-process-msg ange-ftp-process-verbose (not (eq (selected-window) (minibuffer-window))) (not (boundp 'search-message)) ;screws up isearch otherwise @@ -1450,35 +1473,43 @@ associated buffer." (ange-ftp-message "%s...%d%%" ange-ftp-process-msg percent))))))) str) +;; Call the function specified by CONT. CONT can be either a function +;; or a list of a function and some args. The first two parameters +;; passed to the function will be RESULT and LINE. The remaining args +;; will be taken from CONT if a list was passed. + (defun ange-ftp-call-cont (cont result line) - "Call the function specified by CONT. CONT can be either a function or a -list of a function and some args. The first two parameters passed to the -function will be RESULT and LINE. The remaining args will be taken from CONT -if a list was passed." (if cont (if (and (listp cont) (not (eq (car cont) 'lambda))) (apply (car cont) result line (cdr cont)) (funcall cont result line)))) +;; Build up a complete line of output from the ftp PROCESS and pass it +;; on to ange-ftp-process-handle-line to deal with. + (defun ange-ftp-process-filter (proc str) - "Build up a complete line of output from the ftp PROCESS and pass it -on to ange-ftp-process-handle-line to deal with." (let ((buffer (process-buffer proc)) (old-buffer (current-buffer))) + ;; Eliminate nulls. + (while (string-match "\000+" str) + (setq str (replace-match "" nil nil str))) + ;; see if the buffer is still around... it could have been deleted. (if (buffer-name buffer) (unwind-protect - (ange-ftp-save-match-data + (progn (set-buffer (process-buffer proc)) ;; handle hash mark printing - (and ange-ftp-hash-mark-unit - ange-ftp-process-busy + (and ange-ftp-process-busy (string-match "^#+$" str) (setq str (ange-ftp-process-handle-hash str))) - (ange-ftp-process-log-string proc str) + (comint-output-filter proc str) + ;; Replace STR by the result of the comint processing. + (setq str (buffer-substring comint-last-output-start + (process-mark proc))) (if ange-ftp-process-busy (progn (setq ange-ftp-process-string (concat ange-ftp-process-string @@ -1527,13 +1558,12 @@ on to ange-ftp-process-handle-line to deal with." (defun ange-ftp-process-sentinel (proc str) "When ftp process changes state, nuke all file-entries in cache." - (ange-ftp-save-match-data - (let ((name (process-name proc))) - (if (string-match "\\*ftp \\([^@]+\\)@\\([^*]+\\)*" name) - (let ((user (substring name (match-beginning 1) (match-end 1))) - (host (substring name (match-beginning 2) (match-end 2)))) - (ange-ftp-wipe-file-entries host user)))) - (setq ange-ftp-ls-cache-file nil))) + (let ((name (process-name proc))) + (if (string-match "\\*ftp \\([^@]+\\)@\\([^*]+\\)\\*" name) + (let ((user (substring name (match-beginning 1) (match-end 1))) + (host (substring name (match-beginning 2) (match-end 2)))) + (ange-ftp-wipe-file-entries host user)))) + (setq ange-ftp-ls-cache-file nil)) ;;;; ------------------------------------------------------------ ;;;; Gateway support. @@ -1544,13 +1574,13 @@ on to ange-ftp-process-handle-line to deal with." ;; yes, I know that I could simplify the following expression, but it is ;; clearer (to me at least) this way. (and (not ange-ftp-smart-gateway) - (ange-ftp-save-match-data + (save-match-data (not (string-match ange-ftp-local-host-regexp host))))) (defun ange-ftp-use-smart-gateway-p (host) "Returns whether to access this host via a smart gateway." (and ange-ftp-smart-gateway - (ange-ftp-save-match-data + (save-match-data (not (string-match ange-ftp-local-host-regexp host))))) @@ -1607,39 +1637,49 @@ on to ange-ftp-process-handle-line to deal with." (setq ange-ftp-gwp-running nil)) (defun ange-ftp-gwp-filter (proc str) - (ange-ftp-save-match-data - (ange-ftp-process-log-string proc str) - (cond ((string-match "login: *$" str) - (send-string proc - (concat - (let ((ange-ftp-default-user t)) - (ange-ftp-get-user ange-ftp-gateway-host)) - "\n"))) - ((string-match "Password: *$" str) - (send-string proc - (concat - (ange-ftp-get-passwd ange-ftp-gateway-host - (ange-ftp-get-user - ange-ftp-gateway-host)) - "\n"))) - ((string-match ange-ftp-gateway-fatal-msgs str) - (delete-process proc) - (setq ange-ftp-gwp-running nil)) - ((string-match ange-ftp-gateway-prompt-pattern str) - (setq ange-ftp-gwp-running nil - ange-ftp-gwp-status t))))) + (comint-output-filter proc str) + (save-excursion + (set-buffer (process-buffer proc)) + ;; Replace STR by the result of the comint processing. + (setq str (buffer-substring comint-last-output-start (process-mark proc)))) + (cond ((string-match "login: *$" str) + (send-string proc + (concat + (let ((ange-ftp-default-user t)) + (ange-ftp-get-user ange-ftp-gateway-host)) + "\n"))) + ((string-match "Password: *$" str) + (send-string proc + (concat + (ange-ftp-get-passwd ange-ftp-gateway-host + (ange-ftp-get-user + ange-ftp-gateway-host)) + "\n"))) + ((string-match ange-ftp-gateway-fatal-msgs str) + (delete-process proc) + (setq ange-ftp-gwp-running nil)) + ((string-match ange-ftp-gateway-prompt-pattern str) + (setq ange-ftp-gwp-running nil + ange-ftp-gwp-status t)))) (defun ange-ftp-gwp-start (host user name args) "Login to the gateway machine and fire up an ftp process." (let* ((gw-user (ange-ftp-get-user ange-ftp-gateway-host)) - (proc (start-process name name - ange-ftp-gateway-program - ange-ftp-gateway-host)) + ;; It would be nice to make process-connection-type nil, + ;; but that doesn't work: ftp never responds. + ;; Can anyone find a fix for that? + (proc (let ((process-connection-type t)) + (start-process name name + ange-ftp-gateway-program + ange-ftp-gateway-host))) (ftp (mapconcat (function identity) args " "))) (process-kill-without-query proc) (set-process-sentinel proc (function ange-ftp-gwp-sentinel)) (set-process-filter proc (function ange-ftp-gwp-filter)) - (set-marker (process-mark proc) (point)) + (save-excursion + (set-buffer (process-buffer proc)) + (internal-ange-ftp-mode) + (set-marker (process-mark proc) (point))) (setq ange-ftp-gwp-running t ange-ftp-gwp-status nil) (ange-ftp-message "Connecting to gateway %s..." ange-ftp-gateway-host) @@ -1677,16 +1717,7 @@ been queued with no result. CONT will still be called, however." (if (memq (process-status proc) '(run open)) (save-excursion (set-buffer (process-buffer proc)) - (while ange-ftp-process-busy - ;; This is a kludge to let user quit in case ftp gets hung. - ;; It matters because this function can be called from the filter. - ;; It is bad to allow quitting in a filter, but getting hung - ;; is worse. By binding quit-flag to nil, we might avoid - ;; most of the probability of getting screwed because the user - ;; wants to quit some command. - (let ((quit-flag nil) - (inhibit-quit nil)) - (accept-process-output))) + (ange-ftp-wait-not-busy proc) (setq ange-ftp-process-string "" ange-ftp-process-result-line "" ange-ftp-process-busy t @@ -1701,7 +1732,7 @@ been queued with no result. CONT will still be called, however." (goto-char (point-max)) (move-marker comint-last-input-start (point)) ;; don't insert the password into the buffer on the USER command. - (ange-ftp-save-match-data + (save-match-data (if (string-match "^user \"[^\"]*\"" cmd) (insert (substring cmd 0 (match-end 0)) " Turtle Power!\n") (insert cmd))) @@ -1710,23 +1741,47 @@ been queued with no result. CONT will still be called, however." (set-marker (process-mark proc) (point)) (if nowait nil - ;; hang around for command to complete - (while ange-ftp-process-busy - ;; This is a kludge to let user quit in case ftp gets hung. - ;; It matters because this function can be called from the filter. - (let ((quit-flag nil) - (inhibit-quit nil)) - (accept-process-output proc))) + (ange-ftp-wait-not-busy proc) (if cont nil ;cont has already been called (cons ange-ftp-process-result ange-ftp-process-result-line)))))) +;; Wait for the ange-ftp process PROC not to be busy. +(defun ange-ftp-wait-not-busy (proc) + (save-excursion + (set-buffer (process-buffer proc)) + (condition-case nil + ;; This is a kludge to let user quit in case ftp gets hung. + ;; It matters because this function can be called from the filter. + ;; It is bad to allow quitting in a filter, but getting hung + ;; is worse. By binding quit-flag to nil, we might avoid + ;; most of the probability of getting screwed because the user + ;; wants to quit some command. + (let ((quit-flag nil) + (inhibit-quit nil)) + (while ange-ftp-process-busy + (accept-process-output proc))) + (quit + ;; If the user does quit out of this, + ;; kill the process. That stops any transfer in progress. + ;; The next operation will open a new ftp connection. + (delete-process proc) + (signal 'quit nil))))) + (defun ange-ftp-nslookup-host (host) "Attempt to resolve the given HOSTNAME using nslookup if possible." (interactive "sHost: ") (if ange-ftp-nslookup-program - (let ((proc (start-process " *nslookup*" " *nslookup*" - ange-ftp-nslookup-program host)) + (let ((default-directory + (if (file-accessible-directory-p default-directory) + default-directory + exec-directory)) + ;; It would be nice to make process-connection-type nil, + ;; but that doesn't work: ftp never responds. + ;; Can anyone find a fix for that? + (proc (let ((process-connection-type t)) + (start-process " *nslookup*" " *nslookup*" + ange-ftp-nslookup-program host))) (res host)) (process-kill-without-query proc) (save-excursion @@ -1746,19 +1801,38 @@ been queued with no result. CONT will still be called, however." If HOST is only ftp-able through a gateway machine then spawn a shell on the gateway machine to do the ftp instead." (let* ((use-gateway (ange-ftp-use-gateway-p host)) - (ftp-prog (if use-gateway + (use-smart-ftp (and (not ange-ftp-gateway-host) + (ange-ftp-use-smart-gateway-p host))) + (ftp-prog (if (or use-gateway + use-smart-ftp) ange-ftp-gateway-ftp-program-name ange-ftp-ftp-program-name)) (args (append (list ftp-prog) ange-ftp-ftp-program-args)) + ;; Without the following binding, ange-ftp-start-process + ;; recurses on file-accessible-directory-p, since it needs to + ;; restart its process in order to determine anything about + ;; default-directory. + (file-name-handler-alist) + (default-directory + (if (file-accessible-directory-p default-directory) + default-directory + exec-directory)) proc) - (if use-gateway - (if ange-ftp-gateway-program-interactive - (setq proc (ange-ftp-gwp-start host user name args)) - (setq proc (apply 'start-process name name - (append (list ange-ftp-gateway-program - ange-ftp-gateway-host) - args)))) - (setq proc (apply 'start-process name name args))) + ;; It would be nice to make process-connection-type nil, + ;; but that doesn't work: ftp never responds. + ;; Can anyone find a fix for that? + (let ((process-connection-type t) + (process-environment process-environment)) + ;; This tells GNU ftp not to output any fancy escape sequences. + (setenv "TERM" "dumb") + (if use-gateway + (if ange-ftp-gateway-program-interactive + (setq proc (ange-ftp-gwp-start host user name args)) + (setq proc (apply 'start-process name name + (append (list ange-ftp-gateway-program + ange-ftp-gateway-host) + args)))) + (setq proc (apply 'start-process name name args)))) (process-kill-without-query proc) (save-excursion (set-buffer (process-buffer proc)) @@ -1769,6 +1843,9 @@ on the gateway machine to do the ftp instead." proc)) (defun internal-ange-ftp-mode () + "Major mode for interacting with the FTP process. + +\\{comint-mode-map}" (interactive) (comint-mode) (setq major-mode 'internal-ange-ftp-mode) @@ -1792,7 +1869,15 @@ on the gateway machine to do the ftp instead." (make-local-variable 'ange-ftp-last-percent) (setq ange-ftp-hash-mark-count 0) (setq ange-ftp-xfer-size 0) - (setq ange-ftp-process-result-line ""))) + (setq ange-ftp-process-result-line "") + + (setq comint-prompt-regexp "^ftp> ") + (make-local-variable 'comint-password-prompt-regexp) + ;; This is a regexp that can't match anything. + ;; ange-ftp has its own ways of handling passwords. + (setq comint-password-prompt-regexp "^a\\'z") + (make-local-variable 'paragraph-start) + (setq paragraph-start comint-prompt-regexp))) (defun ange-ftp-smart-login (host user pass account proc) "Connect to the FTP-server on HOST as USER using PASSWORD and ACCOUNT. @@ -1829,9 +1914,10 @@ host specified in ``ange-ftp-gateway-host''." (defun ange-ftp-normal-login (host user pass account proc) "Connect to the FTP-server on HOST as USER using PASSWORD and ACCOUNT. PROC is the process to the FTP-client." - (let ((result (ange-ftp-raw-send-cmd + (let* ((nshost (ange-ftp-nslookup-host host)) + (result (ange-ftp-raw-send-cmd proc - (format "open %s" (ange-ftp-nslookup-host host)) + (format "open %s" nshost) (format "Opening FTP connection to %s" host)))) (or (car result) (ange-ftp-error host user @@ -1839,7 +1925,9 @@ PROC is the process to the FTP-client." (cdr result)))) (setq result (ange-ftp-raw-send-cmd proc - (format "user \"%s\" %s %s" user pass account) + (if (ange-ftp-use-smart-gateway-p host) + (format "user \"%s\"@%s %s %s" user nshost pass account) + (format "user \"%s\" %s %s" user pass account)) (format "Logging in as user %s@%s" user host))) (or (car result) (progn @@ -1849,6 +1937,7 @@ PROC is the process to the FTP-client." (concat "USER request failed: " (cdr result))))))) +;; ange@hplb.hpl.hp.com says this should not be changed. (defvar ange-ftp-hash-mark-msgs "[hH]ash mark [^0-9]*\\([0-9]+\\)" "*Regexp matching the FTP client's output upon doing a HASH command.") @@ -1860,7 +1949,7 @@ PROC is the process to the FTP-client." (let* ((status (ange-ftp-raw-send-cmd proc "hash")) (result (car status)) (line (cdr status))) - (ange-ftp-save-match-data + (save-match-data (if (string-match ange-ftp-hash-mark-msgs line) (let ((size (string-to-int (substring line @@ -1874,8 +1963,8 @@ PROC is the process to the FTP-client." (setq ange-ftp-binary-hash-mark-size size))))))))) (defun ange-ftp-get-process (host user) - "Return the process object for a FTP process connected to HOST and -logged in as USER. Create a new process if needed." + "Return an FTP subprocess connected to HOST and logged in as USER. +Create a new process if needed." (let* ((name (ange-ftp-ftp-process-buffer host user)) (proc (get-process name))) (if (and proc (memq (process-status proc) '(run open))) @@ -1888,7 +1977,8 @@ logged in as USER. Create a new process if needed." (setq proc (ange-ftp-start-process host user name)) ;; login to FTP server. - (if (ange-ftp-use-smart-gateway-p host) + (if (and (ange-ftp-use-smart-gateway-p host) + ange-ftp-gateway-host) (ange-ftp-smart-login host user pass account proc) (ange-ftp-normal-login host user pass account proc)) @@ -1951,12 +2041,14 @@ host-type by logging in as USER." ;; (for efficiency) if you log into a particular non-UNIX host frequently. (defvar ange-ftp-fix-name-func-alist nil - "Association list of \( TYPE \. FUNC \) pairs, where FUNC is a routine + "Alist saying how to convert file name to the host's syntax. +Association list of \( TYPE \. FUNC \) pairs, where FUNC is a routine which can change a UNIX file name into a name more suitable for a host of type TYPE.") (defvar ange-ftp-fix-dir-name-func-alist nil - "Association list of \( TYPE \. FUNC \) pairs, where FUNC is a routine + "Alist saying how to convert directory name to the host's syntax. +Association list of \( TYPE \. FUNC \) pairs, where FUNC is a routine which can change UNIX directory name into a directory name more suitable for a host of type TYPE.") @@ -1975,6 +2067,9 @@ and NOWAIT." ;; capability. (let ((cmd0 (car cmd)) (cmd1 (nth 1 cmd)) + (ange-ftp-this-user user) + (ange-ftp-this-host host) + (ange-ftp-this-msg msg) cmd2 cmd3 host-type fix-name-func) (cond @@ -2006,9 +2101,7 @@ and NOWAIT." cmd1 (format "\"%s %s\"" cmd3 cmd1)))) ;; First argument is the remote name - ((let ((ange-ftp-this-user user) - (ange-ftp-this-host host) - (ange-ftp-this-msg msg)) + ((progn (setq fix-name-func (or (cdr (assq host-type ange-ftp-fix-name-func-alist)) 'identity)) @@ -2081,13 +2174,13 @@ and NOWAIT." "^[A-Z0-9._][A-Z0-9._][A-Z0-9._][A-Z0-9._]:$") (defun ange-ftp-guess-host-type (host user) - "Guess at the the host type of HOST by doing a pwd, and examining -the directory syntax." + "Guess at the the host type of HOST. +Works by doing a pwd and examining the directory syntax." (let ((host-type (ange-ftp-host-type host)) (key (concat host "/" user "/~"))) (if (eq host-type 'unix) ;; Note that ange-ftp-host-type returns unix as the default value. - (ange-ftp-save-match-data + (save-match-data (let* ((result (ange-ftp-get-pwd host user)) (dir (car result)) fix-name-func) @@ -2159,11 +2252,11 @@ the directory syntax." ;;;; Remote file and directory listing support. ;;;; ------------------------------------------------------------ +;; Returns whether HOST's FTP server doesn't like \'ls\' or \'dir\' commands +;; to take switch arguments. (defun ange-ftp-dumb-unix-host (host) - "Returns whether HOST's FTP server doesn't like \'ls\' or \'dir\' commands -to take switch arguments." - (and ange-ftp-dumb-unix-host-regexp - (ange-ftp-save-match-data + (and host ange-ftp-dumb-unix-host-regexp + (save-match-data (string-match ange-ftp-dumb-unix-host-regexp host)))) (defun ange-ftp-add-dumb-unix-host (host) @@ -2180,7 +2273,8 @@ to take switch arguments." ange-ftp-host-cache nil))) (defvar ange-ftp-parse-list-func-alist nil - "Association list of \( TYPE \. FUNC \) pairs. The FUNC is a routine + "Alist saying how to parse directory listings for certain OS types. +Association list of \( TYPE \. FUNC \) pairs. The FUNC is a routine which can parse the output from a DIR listing for a host of type TYPE.") ;; With no-error nil, this function returns: @@ -2191,7 +2285,7 @@ which can parse the output from a DIR listing for a host of type TYPE.") ;; ;; With no-error t, it returns: ;; an error if not an ange-ftp-name -;; error if listing is unreable (most likely caused by a slow connection) +;; error if listing is unreadable (most likely caused by a slow connection) ;; nil if ftp error (this is because although asking to list a nonexistent ;; directory on a remote unix machine usually (except ;; maybe for dumb hosts) returns an ls error, but no @@ -2294,15 +2388,16 @@ away in the internal cache." "\\|Nov\\|Dec\\) +[0-3]?[0-9] ")) (defvar ange-ftp-add-file-entry-alist nil - "Association list of pairs \( TYPE \. FUNC \), where FUNC + "Alist saying how to add file entries on certain OS types. +Association list of pairs \( TYPE \. FUNC \), where FUNC is a function to be used to add a file entry for the OS TYPE. The main reason for this alist is to deal with file versions in VMS.") (defvar ange-ftp-delete-file-entry-alist nil - "Association list of pairs \( TYPE \. FUNC \), where FUNC + "Alist saying how to delete files on certain OS types. +Association list of pairs \( TYPE \. FUNC \), where FUNC is a function to be used to delete a file entry for the OS TYPE. -The main reason for this alist is to deal with file versions in -VMS.") +The main reason for this alist is to deal with file versions in VMS.") (defun ange-ftp-add-file-entry (name &optional dir-p) "Add a file entry for file NAME, if its directory info exists." @@ -2393,9 +2488,9 @@ VMS.") ;;; The dl stuff for descriptive listings (defvar ange-ftp-dl-dir-regexp nil - "Regexp matching directories which are listed in dl format. This regexp -shouldn't be anchored with a trailing $ so that it will match subdirectories -as well.") + "Regexp matching directories which are listed in dl format. +This regexp should not be anchored with a trailing `$', because it should +match subdirectories as well.") (defun ange-ftp-add-dl-dir (dir) "Interactively adds a DIR to ange-ftp-dl-dir-regexp." @@ -2428,14 +2523,17 @@ as well.") (ange-ftp-put-hash-entry ".." t tbl) tbl))) +;; Parse the current buffer which is assumed to be in a dired-like listing +;; format, and return a hashtable as the result. If the listing is not really +;; a listing, then return nil. + (defun ange-ftp-parse-dired-listing (&optional switches) - "Parse the current buffer which is assumed to be in a dired-like listing -format, and return a hashtable as the result. If the listing is not really -a listing, then return nil." - (ange-ftp-save-match-data + (save-match-data (cond ((looking-at "^total [0-9]+$") (forward-line 1) + ;; Some systems put in a blank line here. + (if (eolp) (forward-line 1)) (ange-ftp-ls-parser)) ((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'") ;; It's an ls error message. @@ -2470,7 +2568,7 @@ This will give an error or return nil, depending on the value of NO-ERROR, if a listing for DIRECTORY cannot be obtained." (setq directory (file-name-as-directory directory)) ;normalize (or (ange-ftp-get-hash-entry directory ange-ftp-files-hashtable) - (ange-ftp-save-match-data + (save-match-data (and (ange-ftp-ls directory ;; This is an efficiency hack. We try to ;; anticipate what sort of listing dired @@ -2503,22 +2601,23 @@ NO-ERROR, if a listing for DIRECTORY cannot be obtained." (ange-ftp-get-hash-entry directory ange-ftp-files-hashtable))))) +;; Given NAME, return the file part that can be used for looking up the +;; file's entry in a hashtable. (defmacro ange-ftp-get-file-part (name) - "Given NAME, return the file part that can be used for looking up the -file's entry in a hashtable." (` (let ((file (file-name-nondirectory (, name)))) (if (string-equal file "") "." file)))) +;; Return whether ange-ftp-file-entry-p and ange-ftp-get-file-entry are +;; allowed to determine if NAME is a sub-directory by listing it directly, +;; rather than listing its parent directory. This is used for efficiency so +;; that a wasted listing is not done: +;; 1. When looking for a .dired file in dired-x.el. +;; 2. The syntax of FILE and DIR make it impossible that FILE could be a valid +;; subdirectory. This is of course an OS dependent judgement. + (defmacro ange-ftp-allow-child-lookup (dir file) - "Return whether ange-ftp-file-entry-p and ange-ftp-get-file-entry are -allowed to determine if NAME is a sub-directory by listing it directly, -rather than listing its parent directory. This is used for efficiency so -that a wasted listing is not done: -1. When looking for a .dired file in dired-x.el. -2. The syntax of FILE and DIR make it impossible that FILE could be a valid - subdirectory. This is of course an OS dependent judgement." (` (not (let* ((efile (, file)) ; expand once. (edir (, dir)) @@ -2608,8 +2707,7 @@ this also returns nil." files)))) (defun ange-ftp-wipe-file-entries (host user) - "Replace the file entry information hashtable with one that doesn't have any -entries for the given HOST, USER pair." + "Get rid of entry for HOST, USER pair from file entry information hashtable." (let ((new-tbl (ange-ftp-make-hashtable (length ange-ftp-files-hashtable)))) (ange-ftp-map-hashtable (function @@ -2634,7 +2732,9 @@ entries for the given HOST, USER pair." (ange-ftp-error host user (concat "BINARY failed: " (cdr result))) (save-excursion (set-buffer (process-buffer (ange-ftp-get-process host user))) - (setq ange-ftp-hash-mark-unit (ash ange-ftp-binary-hash-mark-size -4)))))) + (and ange-ftp-binary-hash-mark-size + (setq ange-ftp-hash-mark-unit + (ash ange-ftp-binary-hash-mark-size -4))))))) (defun ange-ftp-set-ascii-mode (host user) "Tell the ftp process for the given HOST & USER to switch to ascii mode." @@ -2643,7 +2743,9 @@ entries for the given HOST, USER pair." (ange-ftp-error host user (concat "ASCII failed: " (cdr result))) (save-excursion (set-buffer (process-buffer (ange-ftp-get-process host user))) - (setq ange-ftp-hash-mark-unit (ash ange-ftp-ascii-hash-mark-size -4)))))) + (and ange-ftp-ascii-hash-mark-size + (setq ange-ftp-hash-mark-unit + (ash ange-ftp-ascii-hash-mark-size -4))))))) (defun ange-ftp-cd (host user dir) (let ((result (ange-ftp-send-cmd host user (list 'cd dir) "Doing CD"))) @@ -2658,7 +2760,7 @@ and LINE is the relevant success or fail line from the FTP-client." (line (cdr result)) dir) (if (car result) - (ange-ftp-save-match-data + (save-match-data (and (or (string-match "\"\\([^\"]*\\)\"" line) (string-match " \\([^ ]+\\) " line)) ; stone-age VMS servers! (setq dir (substring line @@ -2671,7 +2773,8 @@ and LINE is the relevant success or fail line from the FTP-client." ;;; ------------------------------------------------------------ (defun ange-ftp-expand-dir (host user dir) - "Return the result of doing a PWD in the current FTP session to machine HOST + "Return the result of doing a PWD in the current FTP session. +Use the connection to machine HOST logged in as user USER and cd'd to directory DIR." (let* ((host-type (ange-ftp-host-type host user)) ;; It is more efficient to call ange-ftp-host-type @@ -2718,7 +2821,7 @@ logged in as user USER and cd'd to directory DIR." (defun ange-ftp-canonize-filename (n) "Take a string and short-circuit //, /. and /.." - (if (string-match ".+//" n) ;don't upset Apollo users + (if (string-match "[^:]+//" n) ;don't upset Apollo users (setq n (substring n (1- (match-end 0))))) (let ((parsed (ange-ftp-ftp-name n))) (if parsed @@ -2753,12 +2856,13 @@ logged in as user USER and cd'd to directory DIR." name)) (error "Unable to obtain CWD"))))) - (setq name (ange-ftp-real-expand-file-name name)) - - ;; see if hit real expand-file-name bug... this will probably annoy - ;; some Apollo people. I'll wait until they shout, however. - (if (string-match "^//" name) - (setq name (substring name 1))) + ;; If name starts with //, preserve that, for apollo system. + (if (not (string-match "^//" name)) + (progn + (setq name (ange-ftp-real-expand-file-name name)) + + (if (string-match "^//" name) + (setq name (substring name 1))))) ;; Now substitute the expanded name back into the overall filename. (ange-ftp-replace-name-component n name)) @@ -2772,9 +2876,9 @@ logged in as user USER and cd'd to directory DIR." (defun ange-ftp-expand-file-name (name &optional default) "Documented as original." - (ange-ftp-save-match-data + (save-match-data (if (eq (string-to-char name) ?/) - (while (cond ((string-match ".+//" name) ;don't upset Apollo users + (while (cond ((string-match "[^:]+//" name) ;don't upset Apollo users (setq name (substring name (1- (match-end 0))))) ((string-match "/~" name) (setq name (substring name (1- (match-end 0)))))))) @@ -2791,7 +2895,7 @@ logged in as user USER and cd'd to directory DIR." ;;; These are problems--they are currently not enabled. (defvar ange-ftp-file-name-as-directory-alist nil - "Association list of \( TYPE \. FUNC \) pairs, where + "Association list of \( TYPE \. FUNC \) pairs. FUNC converts a filename to a directory name for the operating system TYPE.") @@ -2813,7 +2917,7 @@ system TYPE.") (let ((parsed (ange-ftp-ftp-name name))) (if parsed (let ((filename (nth 2 parsed))) - (if (ange-ftp-save-match-data + (if (save-match-data (string-match "^~[^/]*$" filename)) name (ange-ftp-replace-name-component @@ -2826,7 +2930,7 @@ system TYPE.") (let ((parsed (ange-ftp-ftp-name name))) (if parsed (let ((filename (nth 2 parsed))) - (if (ange-ftp-save-match-data + (if (save-match-data (string-match "^~[^/]*$" filename)) "" (ange-ftp-real-file-name-nondirectory name))) @@ -2846,7 +2950,7 @@ system TYPE.") ;; Returns non-nil if should transfer FILE in binary mode. (defun ange-ftp-binary-file (file) - (ange-ftp-save-match-data + (save-match-data (string-match ange-ftp-binary-file-name-regexp file))) (defun ange-ftp-write-region (start end filename &optional append visit) @@ -2857,12 +2961,13 @@ system TYPE.") (user (nth 1 parsed)) (name (ange-ftp-quote-string (nth 2 parsed))) (temp (ange-ftp-make-tmp-name host)) - (binary (ange-ftp-binary-file filename)) + (binary (or (ange-ftp-binary-file filename) + (eq (ange-ftp-host-type host user) 'unix))) (cmd (if append 'append 'put)) (abbr (ange-ftp-abbreviate-filename filename))) (unwind-protect (progn - (let ((executing-macro t) + (let ((executing-kbd-macro t) (filename (buffer-file-name)) (mod-p (buffer-modified-p))) (unwind-protect @@ -2893,6 +2998,7 @@ system TYPE.") (ange-ftp-set-ascii-mode host user))) (if (eq visit t) (progn + (set-visited-file-modtime '(0 0)) (ange-ftp-set-buffer-mode) (setq buffer-file-name filename) (set-buffer-modified-p nil))) @@ -2900,7 +3006,7 @@ system TYPE.") (ange-ftp-add-file-entry filename)) (ange-ftp-real-write-region start end filename append visit)))) -(defun ange-ftp-insert-file-contents (filename &optional visit) +(defun ange-ftp-insert-file-contents (filename &optional visit beg end replace) (barf-if-buffer-read-only) (setq filename (expand-file-name filename)) (let ((parsed (ange-ftp-ftp-name filename))) @@ -2918,7 +3024,8 @@ system TYPE.") (user (nth 1 parsed)) (name (ange-ftp-quote-string (nth 2 parsed))) (temp (ange-ftp-make-tmp-name host)) - (binary (ange-ftp-binary-file filename)) + (binary (or (ange-ftp-binary-file filename) + (eq (ange-ftp-host-type host user) 'unix))) (abbr (ange-ftp-abbreviate-filename filename)) size) (unwind-protect @@ -2940,8 +3047,8 @@ system TYPE.") (ange-ftp-real-file-readable-p temp)) (setq size - (nth 1 (ange-ftp-real-insert-file-contents temp - visit))) + (nth 1 (ange-ftp-real-insert-file-contents + temp visit beg end replace))) (signal 'ftp-error (list "Opening input file:" @@ -2952,13 +3059,15 @@ system TYPE.") (ange-ftp-set-ascii-mode host user)) (ange-ftp-del-tmp-name temp)) (if visit - (setq buffer-file-name filename)) + (progn + (set-visited-file-modtime '(0 0)) + (setq buffer-file-name filename))) (list filename size)) (signal 'file-error (list "Opening input file" filename)))) - (ange-ftp-real-insert-file-contents filename visit)))) + (ange-ftp-real-insert-file-contents filename visit beg end replace)))) (defun ange-ftp-expand-symlink (file dir) (if (file-name-absolute-p file) @@ -3021,7 +3130,7 @@ system TYPE.") (ange-ftp-get-files directory))) files f) (setq directory (file-name-as-directory directory)) - (ange-ftp-save-match-data + (save-match-data (while tail (setq f (car tail) tail (cdr tail)) @@ -3079,6 +3188,12 @@ system TYPE.") (file-exists-p file) (ange-ftp-real-file-readable-p file))) +(defun ange-ftp-file-executable-p (file) + (setq file (expand-file-name file)) + (if (ange-ftp-ftp-name file) + (file-exists-p file) + (ange-ftp-real-file-executable-p file))) + (defun ange-ftp-delete-file (file) (interactive "fDelete file: ") (setq file (expand-file-name file)) @@ -3190,7 +3305,9 @@ system TYPE.") (t-name (and t-parsed (ange-ftp-quote-string (nth 2 t-parsed)))) (t-abbr (ange-ftp-abbreviate-filename newname filename)) (binary (or (ange-ftp-binary-file filename) - (ange-ftp-binary-file newname))) + (ange-ftp-binary-file newname) + (and (eq (ange-ftp-host-type f-host f-user) 'unix) + (eq (ange-ftp-host-type t-host t-user) 'unix)))) temp1 temp2) @@ -3349,8 +3466,7 @@ system TYPE.") ;;;; File renaming support. ;;;; ------------------------------------------------------------ -(defun ange-ftp-rename-remote-to-remote (filename newname f-parsed t-parsed - binary) +(defun ange-ftp-rename-remote-to-remote (filename newname f-parsed t-parsed) "Rename remote file FILE to remote file NEWNAME." (let ((f-host (nth 0 f-parsed)) (f-user (nth 1 f-parsed)) @@ -3402,8 +3518,7 @@ system TYPE.") (setq filename (expand-file-name filename)) (setq newname (expand-file-name newname)) (let* ((f-parsed (ange-ftp-ftp-name filename)) - (t-parsed (ange-ftp-ftp-name newname)) - (binary (if (or f-parsed t-parsed) (ange-ftp-binary-file filename)))) + (t-parsed (ange-ftp-ftp-name newname))) (if (and (or f-parsed t-parsed) (or (not ok-if-already-exists) (numberp ok-if-already-exists))) @@ -3414,7 +3529,7 @@ system TYPE.") (if f-parsed (if t-parsed (ange-ftp-rename-remote-to-remote filename newname f-parsed - t-parsed binary) + t-parsed) (ange-ftp-rename-remote-to-local filename newname)) (if t-parsed (ange-ftp-rename-local-to-remote filename newname) @@ -3497,7 +3612,7 @@ system TYPE.") "/"))) ; / never in filename completion-ignored-extensions "\\|"))) - (ange-ftp-save-match-data + (save-match-data (or (ange-ftp-file-name-completion-1 file tbl ange-ftp-this-dir (function ange-ftp-file-entry-not-ignored-p)) @@ -3620,19 +3735,29 @@ system TYPE.") (let* ((fn1 (expand-file-name file)) (pa1 (ange-ftp-ftp-name fn1))) (if pa1 - (let* ((tmp1 (ange-ftp-make-tmp-name (car pa1))) - (bin1 (ange-ftp-binary-file fn1))) + (let ((tmp1 (ange-ftp-make-tmp-name (car pa1)))) (ange-ftp-copy-file-internal fn1 tmp1 t nil (format "Getting %s" fn1)) tmp1)))) -(defun ange-ftp-load (file) +(defun ange-ftp-load (file &optional noerror nomessage nosuffix) (if (ange-ftp-ftp-name file) - (let ((copy (ange-ftp-file-local-copy file))) - (unwind-protect - (load copy) - (delete-file copy))) - (ange-ftp-real-load file))) + (let ((tryfiles (if nosuffix + (list file) + (list (concat file ".elc") (concat file ".el") file))) + copy) + (while (and tryfiles (not copy)) + (condition-case error + (setq copy (ange-ftp-file-local-copy (car tryfiles))) + (ftp-error nil)) + (setq tryfiles (cdr tryfiles))) + (if copy + (unwind-protect + (funcall 'load copy noerror nomessage nosuffix) + (delete-file copy)) + (or noerror + (signal 'file-error (list "Cannot open load file" file))))) + (ange-ftp-real-load file noerror nomessage nosuffix))) ;; Calculate default-unhandled-directory for a given ange-ftp buffer. (defun ange-ftp-unhandled-file-name-directory (filename) @@ -3660,7 +3785,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (cdr (assq (ange-ftp-host-type (car parsed)) ange-ftp-make-compressed-filename-alist)))) (let* ((decision - (ange-ftp-save-match-data (funcall conversion-func name))) + (save-match-data (funcall conversion-func name))) (compressing (car decision)) (newfile (nth 1 decision))) (if compressing @@ -3736,6 +3861,12 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (ange-ftp-copy-file-internal tmp2 nfile t nil msg2)))) (ange-ftp-del-tmp-name tmp1) (ange-ftp-del-tmp-name tmp2)))) + +(defun ange-ftp-find-backup-file-name (fn) + ;; Either return the ordinary backup name, etc., + ;; or return nil meaning don't make a backup. + (if ange-ftp-make-backup-files + (ange-ftp-real-find-backup-file-name fn))) ;;; Define the handler for special file names ;;; that causes ange-ftp to be invoked. @@ -3744,13 +3875,24 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (defun ange-ftp-hook-function (operation &rest args) (let ((fn (get operation 'ange-ftp))) (if fn (apply fn args) - (let (file-name-handler-alist) - (apply operation args))))) + (ange-ftp-run-real-handler operation args)))) + + +;;; This regexp takes care of real ange-ftp file names (with a slash +;;; and colon). +;;; Don't allow the host name to end in a period--some systems use /.: +;;;###autoload +(or (assoc "^/[^/:]*[^/:.]:" file-name-handler-alist) + (setq file-name-handler-alist + (cons '("^/[^/:]*[^/:.]:" . ange-ftp-hook-function) + file-name-handler-alist))) +;;; This regexp recognizes and absolute filenames with only one component, +;;; for the sake of hostname completion. ;;;###autoload -(or (assoc "^/[^/:]+:" file-name-handler-alist) +(or (assoc "^/[^/:]*\\'" file-name-handler-alist) (setq file-name-handler-alist - (cons '("^/[^/:]+:" . ange-ftp-hook-function) + (cons '("^/[^/:]*\\'" . ange-ftp-completion-hook-function) file-name-handler-alist))) ;;; The above two forms are sufficient to cause this file to be loaded @@ -3775,6 +3917,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (put 'file-directory-p 'ange-ftp 'ange-ftp-file-directory-p) (put 'file-writable-p 'ange-ftp 'ange-ftp-file-writable-p) (put 'file-readable-p 'ange-ftp 'ange-ftp-file-readable-p) +(put 'file-executable-p 'ange-ftp 'ange-ftp-file-executable-p) (put 'file-symlink-p 'ange-ftp 'ange-ftp-file-symlink-p) (put 'delete-file 'ange-ftp 'ange-ftp-delete-file) (put 'read-file-name-internal 'ange-ftp 'ange-ftp-read-file-name-internal) @@ -3796,6 +3939,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (put 'dired-uncache 'ange-ftp 'ange-ftp-dired-uncache) (put 'dired-compress-file 'ange-ftp 'ange-ftp-dired-compress-file) (put 'load 'ange-ftp 'ange-ftp-load) +(put 'find-backup-file-name 'ange-ftp 'ange-ftp-find-backup-file-name) ;; Turn off truename processing to save time. ;; Treat each name as its own truename. @@ -3804,94 +3948,81 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ;; Turn off RCS/SCCS processing to save time. ;; This returns nil for any file name as argument. (put 'vc-registered 'ange-ftp 'null) + +(put 'dired-call-process 'ange-ftp 'ange-ftp-dired-call-process) ;;; Define ways of getting at unmodified Emacs primitives, ;;; turning off our handler. +(defun ange-ftp-run-real-handler (operation args) + (let ((inhibit-file-name-handlers + (cons 'ange-ftp-hook-function + (cons 'ange-ftp-completion-hook-function + (and (eq inhibit-file-name-operation operation) + inhibit-file-name-handlers)))) + (inhibit-file-name-operation operation)) + (apply operation args))) + (defun ange-ftp-real-file-name-directory (&rest args) - (let (file-name-handler-alist) - (apply 'file-name-directory args))) + (ange-ftp-run-real-handler 'file-name-directory args)) (defun ange-ftp-real-file-name-nondirectory (&rest args) - (let (file-name-handler-alist) - (apply 'file-name-nondirectory args))) + (ange-ftp-run-real-handler 'file-name-nondirectory args)) (defun ange-ftp-real-file-name-as-directory (&rest args) - (let (file-name-handler-alist) - (apply 'file-name-as-directory args))) + (ange-ftp-run-real-handler 'file-name-as-directory args)) (defun ange-ftp-real-directory-file-name (&rest args) - (let (file-name-handler-alist) - (apply 'directory-file-name args))) + (ange-ftp-run-real-handler 'directory-file-name args)) (defun ange-ftp-real-expand-file-name (&rest args) - (let (file-name-handler-alist) - (apply 'expand-file-name args))) + (ange-ftp-run-real-handler 'expand-file-name args)) (defun ange-ftp-real-make-directory (&rest args) - (let (file-name-handler-alist) - (apply 'make-directory args))) + (ange-ftp-run-real-handler 'make-directory args)) (defun ange-ftp-real-delete-directory (&rest args) - (let (file-name-handler-alist) - (apply 'delete-directory args))) + (ange-ftp-run-real-handler 'delete-directory args)) (defun ange-ftp-real-insert-file-contents (&rest args) - (let (file-name-handler-alist) - (apply 'insert-file-contents args))) + (ange-ftp-run-real-handler 'insert-file-contents args)) (defun ange-ftp-real-directory-files (&rest args) - (let (file-name-handler-alist) - (apply 'directory-files args))) + (ange-ftp-run-real-handler 'directory-files args)) (defun ange-ftp-real-file-directory-p (&rest args) - (let (file-name-handler-alist) - (apply 'file-directory-p args))) + (ange-ftp-run-real-handler 'file-directory-p args)) (defun ange-ftp-real-file-writable-p (&rest args) - (let (file-name-handler-alist) - (apply 'file-writable-p args))) + (ange-ftp-run-real-handler 'file-writable-p args)) (defun ange-ftp-real-file-readable-p (&rest args) - (let (file-name-handler-alist) - (apply 'file-readable-p args))) + (ange-ftp-run-real-handler 'file-readable-p args)) +(defun ange-ftp-real-file-executable-p (&rest args) + (ange-ftp-run-real-handler 'file-executable-p args)) (defun ange-ftp-real-file-symlink-p (&rest args) - (let (file-name-handler-alist) - (apply 'file-symlink-p args))) + (ange-ftp-run-real-handler 'file-symlink-p args)) (defun ange-ftp-real-delete-file (&rest args) - (let (file-name-handler-alist) - (apply 'delete-file args))) + (ange-ftp-run-real-handler 'delete-file args)) (defun ange-ftp-real-read-file-name-internal (&rest args) - (let (file-name-handler-alist) - (apply 'read-file-name-internal args))) + (ange-ftp-run-real-handler 'read-file-name-internal args)) (defun ange-ftp-real-verify-visited-file-modtime (&rest args) - (let (file-name-handler-alist) - (apply 'verify-visited-file-modtime args))) + (ange-ftp-run-real-handler 'verify-visited-file-modtime args)) (defun ange-ftp-real-file-exists-p (&rest args) - (let (file-name-handler-alist) - (apply 'file-exists-p args))) + (ange-ftp-run-real-handler 'file-exists-p args)) (defun ange-ftp-real-write-region (&rest args) - (let (file-name-handler-alist) - (apply 'write-region args))) + (ange-ftp-run-real-handler 'write-region args)) (defun ange-ftp-real-backup-buffer (&rest args) - (let (file-name-handler-alist) - (apply 'backup-buffer args))) + (ange-ftp-run-real-handler 'backup-buffer args)) (defun ange-ftp-real-copy-file (&rest args) - (let (file-name-handler-alist) - (apply 'copy-file args))) + (ange-ftp-run-real-handler 'copy-file args)) (defun ange-ftp-real-rename-file (&rest args) - (let (file-name-handler-alist) - (apply 'rename-file args))) + (ange-ftp-run-real-handler 'rename-file args)) (defun ange-ftp-real-file-attributes (&rest args) - (let (file-name-handler-alist) - (apply 'file-attributes args))) + (ange-ftp-run-real-handler 'file-attributes args)) (defun ange-ftp-real-file-name-all-completions (&rest args) - (let (file-name-handler-alist) - (apply 'file-name-all-completions args))) + (ange-ftp-run-real-handler 'file-name-all-completions args)) (defun ange-ftp-real-file-name-completion (&rest args) - (let (file-name-handler-alist) - (apply 'file-name-completion args))) + (ange-ftp-run-real-handler 'file-name-completion args)) (defun ange-ftp-real-insert-directory (&rest args) - (let (file-name-handler-alist) - (apply 'insert-directory args))) + (ange-ftp-run-real-handler 'insert-directory args)) (defun ange-ftp-real-file-name-sans-versions (&rest args) - (let (file-name-handler-alist) - (apply 'file-name-sans-versions args))) + (ange-ftp-run-real-handler 'file-name-sans-versions args)) (defun ange-ftp-real-shell-command (&rest args) - (let (file-name-handler-alist) - (apply 'shell-command args))) + (ange-ftp-run-real-handler 'shell-command args)) (defun ange-ftp-real-load (&rest args) - (let (file-name-handler-alist) - (apply 'load args))) + (ange-ftp-run-real-handler 'load args)) +(defun ange-ftp-real-find-backup-file-name (&rest args) + (ange-ftp-run-real-handler 'find-backup-file-name args)) ;; Here we support using dired on remote hosts. ;; I have turned off the support for using dired on foreign directory formats. @@ -3907,7 +4038,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (defun ange-ftp-insert-directory (file switches &optional wildcard full) (let ((short (ange-ftp-abbreviate-filename file)) - (parsed (ange-ftp-ftp-name file))) + (parsed (ange-ftp-ftp-name (expand-file-name file)))) (if parsed (insert (if wildcard @@ -3917,8 +4048,8 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (ange-ftp-real-insert-directory file switches wildcard full)))) (defun ange-ftp-dired-uncache (dir) - (if (ange-ftp-ftp-name (expand-file-name dir))) - (setq ange-ftp-ls-cache-file nil)) + (if (ange-ftp-ftp-name (expand-file-name dir)) + (setq ange-ftp-ls-cache-file nil))) (defvar ange-ftp-sans-version-alist nil "Alist of mapping host type into function to remove file version numbers.") @@ -3934,12 +4065,6 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (if func (funcall func file keep-backup-version) (ange-ftp-real-file-name-sans-versions file keep-backup-version)))) -(defvar ange-ftp-remote-shell-file-name - (if (memq system-type '(hpux usg-unix-v)) ; hope that's right - "remsh" - "rsh") - "Name of command to run a remote shell, for ange-ftp.") - ;;; This doesn't work yet; a new hook needs to be created. ;;; Maybe the new hook should be in call-process. (defun ange-ftp-shell-command (command) @@ -3954,14 +4079,14 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (setq command (format "%s %s \"%s\"" ; remsh -l USER does not work well ; on a hp-ux machine I tried - ange-ftp-remote-shell-file-name host command)) + remote-shell-program host command)) (ange-ftp-message "Remote command '%s' ..." command) ;; Cannot call ange-ftp-real-dired-run-shell-command here as it ;; would prepend "cd default-directory" --- which bombs because ;; default-directory is in ange-ftp syntax for remote file names. (ange-ftp-real-shell-command command)))) -;;; Thisis not hooked up yet. +;;; This is the handler for call-process. (defun ange-ftp-dired-call-process (program discard &rest arguments) ;; PROGRAM is always one of those below in the cond in dired.el. ;; The ARGUMENTS are (nearly) always files. @@ -3977,11 +4102,18 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (ftp-error (insert (format "%s: %s, %s\n" (nth 1 oops) (nth 2 oops) - (nth 3 oops)))) - (error (insert (format "%s\n" (nth 1 oops))))) + (nth 3 oops))) + ;; Caller expects nonzero value to mean failure. + 1) + (error (insert (format "%s\n" (nth 1 oops))) + 1)) (apply 'call-process program nil (not discard) nil arguments))) -;;; This currently does not work; it is never called. +(defvar ange-ftp-remote-shell "rsh" + "Remote shell to use for chmod, if FTP server rejects the `chmod' command.") + +;; Handle an attempt to run chmod on a remote file +;; by using the ftp chmod command. (defun ange-ftp-call-chmod (args) (if (< (length args) 2) (error "ange-ftp-call-chmod: missing mode and/or filename: %s" args)) @@ -4001,12 +4133,12 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (format "doing chmod %s" abbr)))) (or (car result) - (ange-ftp-error host user - (format "chmod: %s: \"%s\"" - file - (cdr result))))))))) + (call-process + ange-ftp-remote-shell + nil t nil host "chmod" mode name))))))) (cdr args))) - (setq ange-ftp-ls-cache-file nil)) ;stop confusing dired + (setq ange-ftp-ls-cache-file nil) ;Stop confusing Dired. + 0) ;;; This is turned off because it has nothing properly to do ;;; with dired. It could be reasonable to adapt this to @@ -4318,7 +4450,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ; ;(defun ange-ftp-vos-host (host) ; (and ange-ftp-vos-host-regexp -; (ange-ftp-save-match-data +; (save-match-data ; (string-match ange-ftp-vos-host-regexp host)))) ; ;(defun ange-ftp-parse-vos-listing () @@ -4330,7 +4462,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ; ("^Dirs: [0-9]+\n+" t 30))) ; type-regexp type-is-dir type-col file) ; (goto-char (point-min)) -; (ange-ftp-save-match-data +; (save-match-data ; (while type-list ; (setq type-regexp (car (car type-list)) ; type-is-dir (nth 1 (car type-list)) @@ -4361,7 +4493,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ;; Convert NAME from UNIX-ish to VMS. If REVERSE given then convert from VMS ;; to UNIX-ish. (defun ange-ftp-fix-name-for-vms (name &optional reverse) - (ange-ftp-save-match-data + (save-match-data (if reverse (if (string-match "^\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)$" name) (let (drive dir file) @@ -4447,7 +4579,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ;; Return non-nil if HOST is running VMS. (defun ange-ftp-vms-host (host) (and ange-ftp-vms-host-regexp - (ange-ftp-save-match-data + (save-match-data (string-match ange-ftp-vms-host-regexp host)))) ;; Because some VMS ftp servers convert filenames to lower case @@ -4455,8 +4587,8 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (defconst ange-ftp-vms-filename-regexp (concat - "\\(\\([_A-Za-z0-9$]?\\|[_A-Za-z0-9$][_A-Za-z0-9$---]*\\)\\." - "[_A-Za-z0-9$---]*;+[0-9]*\\)") + "\\(\\([_A-Za-z0-9$]?\\|[_A-Za-z0-9$][-_A-Za-z0-9$]*\\)\\." + "[-_A-Za-z0-9$]*;+[0-9]*\\)") "Regular expression to match for a valid VMS file name in Dired buffer. Stupid freaking bug! Position of _ and $ shouldn't matter but they do. Having [A-Z0-9$_] bombs on filename _$$CHANGE_LOG$.TXT$ and $CHANGE_LOG$.TX @@ -4481,7 +4613,7 @@ Other orders of $ and _ seem to all work just fine.") (let ((tbl (ange-ftp-make-hashtable)) file) (goto-char (point-min)) - (ange-ftp-save-match-data + (save-match-data (while (setq file (ange-ftp-parse-vms-filename)) (if (string-match "\\.\\(DIR\\|dir\\);[0-9]+" file) ;; deal with directories @@ -4515,7 +4647,7 @@ Other orders of $ and _ seem to all work just fine.") (defun ange-ftp-vms-delete-file-entry (name &optional dir-p) (if dir-p (ange-ftp-internal-delete-file-entry name t) - (ange-ftp-save-match-data + (save-match-data (let ((file (ange-ftp-get-file-part name))) (if (string-match ";[0-9]+$" file) ;; In VMS you can't delete a file without an explicit @@ -4556,7 +4688,7 @@ Other orders of $ and _ seem to all work just fine.") ange-ftp-files-hashtable))) (if files (let ((file (ange-ftp-get-file-part name))) - (ange-ftp-save-match-data + (save-match-data (if (string-match ";[0-9]+$" file) (ange-ftp-put-hash-entry (substring file 0 (match-beginning 0)) @@ -4605,7 +4737,7 @@ Other orders of $ and _ seem to all work just fine.") (defun ange-ftp-vms-file-name-as-directory (name) - (ange-ftp-save-match-data + (save-match-data (if (string-match "\\.\\(DIR\\|dir\\)\\(;[0-9]+\\)?$" name) (setq name (substring name 0 (match-beginning 0)))) (ange-ftp-real-file-name-as-directory name))) @@ -4766,8 +4898,8 @@ Other orders of $ and _ seem to all work just fine.") ;; (cons '(vms . ange-ftp-dired-vms-ls-trim) ;; ange-ftp-dired-ls-trim-alist))) -(defun ange-ftp-vms-sans-version (name) - (ange-ftp-save-match-data +(defun ange-ftp-vms-sans-version (name &rest args) + (save-match-data (if (string-match ";[0-9]+$" name) (substring name 0 (match-beginning 0)) name))) @@ -4924,7 +5056,7 @@ Other orders of $ and _ seem to all work just fine.") ;; Convert NAME from UNIX-ish to MTS. If REVERSE given then convert from ;; MTS to UNIX-ish. (defun ange-ftp-fix-name-for-mts (name &optional reverse) - (ange-ftp-save-match-data + (save-match-data (if reverse (if (string-match "^\\([^:]+:\\)?\\(.*\\)$" name) (let (acct file) @@ -4974,14 +5106,14 @@ Other orders of $ and _ seem to all work just fine.") ;; Return non-nil if HOST is running MTS. (defun ange-ftp-mts-host (host) (and ange-ftp-mts-host-regexp - (ange-ftp-save-match-data + (save-match-data (string-match ange-ftp-mts-host-regexp host)))) ;; Parse the current buffer which is assumed to be in mts ftp dir format. (defun ange-ftp-parse-mts-listing () (let ((tbl (ange-ftp-make-hashtable))) (goto-char (point-min)) - (ange-ftp-save-match-data + (save-match-data (while (re-search-forward ange-ftp-date-regexp nil t) (end-of-line) (skip-chars-backward " ") @@ -5078,7 +5210,7 @@ Other orders of $ and _ seem to all work just fine.") ;;;; ------------------------------------------------------------ ;; Since CMS doesn't have any full file name syntax, we have to fudge -;; things with cd's. We actually send too many cd's, but is dangerous +;; things with cd's. We actually send too many cd's, but it's dangerous ;; to try to remember the current minidisk, because if the connection ;; is closed and needs to be reopened, we will find ourselves back in ;; the default minidisk. This is fairly likely since CMS ftp servers @@ -5087,7 +5219,7 @@ Other orders of $ and _ seem to all work just fine.") ;; Have I got the filename character set right? (defun ange-ftp-fix-name-for-cms (name &optional reverse) - (ange-ftp-save-match-data + (save-match-data (if reverse ;; Since we only convert output from a pwd in this direction, ;; we'll assume that it's a minidisk, and make it into a @@ -5162,7 +5294,7 @@ Other orders of $ and _ seem to all work just fine.") file ;; give up (ange-ftp-error ange-ftp-this-host ange-ftp-this-user - (format "cd to minidisk %s failed: " + (format "cd to minidisk %s failed: %s" minidisk (cdr result)))))))) (t (error "Invalid CMS file name")))) @@ -5177,7 +5309,7 @@ Other orders of $ and _ seem to all work just fine.") ;; Return non-nil if HOST is running CMS. (defun ange-ftp-cms-host (host) (and ange-ftp-cms-host-regexp - (ange-ftp-save-match-data + (save-match-data (string-match ange-ftp-cms-host-regexp host)))) (defun ange-ftp-add-cms-host (host) @@ -5214,7 +5346,7 @@ Other orders of $ and _ seem to all work just fine.") ;; Now do the usual parsing (let ((tbl (ange-ftp-make-hashtable))) (goto-char (point-min)) - (ange-ftp-save-match-data + (save-match-data (while (re-search-forward "^\\([-A-Z0-9$_]+\\) +\\([-A-Z0-9$_]+\\) +[VF] +[0-9]+ " nil t)