LCOV - code coverage report
Current view: top level - lisp/net - ange-ftp.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 75 2368 3.2 %
Date: 2017-08-30 10:12:24 Functions: 19 215 8.8 %

          Line data    Source code
       1             : ;;; ange-ftp.el --- transparent FTP support for GNU Emacs
       2             : 
       3             : ;; Copyright (C) 1989-1996, 1998, 2000-2017 Free Software Foundation,
       4             : ;; Inc.
       5             : 
       6             : ;; Author: Andy Norman (ange@hplb.hpl.hp.com)
       7             : ;; Maintainer: emacs-devel@gnu.org
       8             : ;; Keywords: comm
       9             : 
      10             : ;; This file is part of GNU Emacs.
      11             : 
      12             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      13             : ;; it under the terms of the GNU General Public License as published by
      14             : ;; the Free Software Foundation, either version 3 of the License, or
      15             : ;; (at your option) any later version.
      16             : 
      17             : ;; GNU Emacs is distributed in the hope that it will be useful,
      18             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      19             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      20             : ;; GNU General Public License for more details.
      21             : 
      22             : ;; You should have received a copy of the GNU General Public License
      23             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      24             : 
      25             : ;;; Commentary:
      26             : 
      27             : ;; This package attempts to make accessing files and directories using FTP
      28             : ;; from within GNU Emacs as simple and transparent as possible.  A subset of
      29             : ;; the common file-handling routines are extended to interact with FTP.
      30             : 
      31             : ;; Usage:
      32             : ;;
      33             : ;; Some of the common GNU Emacs file-handling operations have been made
      34             : ;; FTP-smart.  If one of these routines is given a filename that matches
      35             : ;; '/user@host:name' then it will spawn an FTP process connecting to machine
      36             : ;; 'host' as account 'user' and perform its operation on the file 'name'.
      37             : ;;
      38             : ;; For example: if find-file is given a filename of:
      39             : ;;
      40             : ;;   /ange@anorman:/tmp/notes
      41             : ;;
      42             : ;; then ange-ftp spawns an FTP process, connect to the host 'anorman' as
      43             : ;; user 'ange', get the file '/tmp/notes' and pop up a buffer containing the
      44             : ;; contents of that file as if it were on the local filesystem.  If ange-ftp
      45             : ;; needs a password to connect then it reads one in the echo area.
      46             : 
      47             : ;; Extended filename syntax:
      48             : ;;
      49             : ;; The default extended filename syntax is '/user@host:name', where the
      50             : ;; 'user@' part may be omitted.  This syntax can be customized to a certain
      51             : ;; extent by changing ange-ftp-name-format.  There are limitations.
      52             : ;; The `host' part has an optional suffix `#port' which may be used to
      53             : ;; specify a non-default port number for the connection.
      54             : ;;
      55             : ;; If the user part is omitted then ange-ftp generates a default user
      56             : ;; instead whose value depends on the variable ange-ftp-default-user.
      57             : 
      58             : ;; Passwords:
      59             : ;;
      60             : ;; A password is required for each host/user pair.  Ange-ftp reads passwords
      61             : ;; as needed.  You can also specify a password with ange-ftp-set-passwd, or
      62             : ;; in a *valid* ~/.netrc file.
      63             : 
      64             : ;; Passwords for user "anonymous":
      65             : ;;
      66             : ;; Passwords for the user "anonymous" (or "ftp") are handled
      67             : ;; specially.  The variable `ange-ftp-generate-anonymous-password'
      68             : ;; controls what happens: if the value of this variable is a string,
      69             : ;; then this is used as the password; if non-nil (the default), then
      70             : ;; the value of `user-mail-address' is used; if nil then the user
      71             : ;; is prompted for a password as normal.
      72             : 
      73             : ;; "Dumb" UNIX hosts:
      74             : ;;
      75             : ;; The FTP servers on some UNIX machines have problems if the 'ls' command is
      76             : ;; used.
      77             : ;;
      78             : ;; The routine ange-ftp-add-dumb-unix-host can be called to tell ange-ftp to
      79             : ;; limit itself to the DIR command and not 'ls' for a given UNIX host.  Note
      80             : ;; that this change will take effect for the current GNU Emacs session only.
      81             : ;; See below for a discussion of non-UNIX hosts.  If a large number of
      82             : ;; machines with similar hostnames have this problem then it is easier to set
      83             : ;; the value of ange-ftp-dumb-unix-host-regexp in your init file.  ange-ftp
      84             : ;; is unable to automatically recognize dumb unix hosts.
      85             : 
      86             : ;; File name completion:
      87             : ;;
      88             : ;; Full file-name completion is supported on UNIX, VMS, CMS, and MTS hosts.
      89             : ;; To do filename completion, ange-ftp needs a listing from the remote host.
      90             : ;; Therefore, for very slow connections, it might not save any time.
      91             : 
      92             : ;; FTP processes:
      93             : ;;
      94             : ;; When ange-ftp starts up an FTP process, it leaves it running for speed
      95             : ;; purposes.  Some FTP servers will close the connection after a period of
      96             : ;; time, but ange-ftp should be able to quietly reconnect the next time that
      97             : ;; the process is needed.
      98             : ;;
      99             : ;; Killing the "*ftp user@host*" buffer also kills the ftp process.
     100             : ;; This should not cause ange-ftp any grief.
     101             : 
     102             : ;; Binary file transfers:
     103             : ;;
     104             : ;; By default ange-ftp transfers files in ASCII mode.  If a file being
     105             : ;; transferred matches the value of ange-ftp-binary-file-name-regexp then
     106             : ;; binary mode is used for that transfer.
     107             : 
     108             : ;; Account passwords:
     109             : ;;
     110             : ;; Some FTP servers require an additional password which is sent by the
     111             : ;; ACCOUNT command.  ange-ftp partially supports this by allowing the user to
     112             : ;; specify an account password by either calling ange-ftp-set-account, or by
     113             : ;; specifying an account token in the .netrc file.  If the account password
     114             : ;; is set by either of these methods then ange-ftp will issue an ACCOUNT
     115             : ;; command upon starting the FTP process.
     116             : 
     117             : ;; Preloading:
     118             : ;;
     119             : ;; ange-ftp can be preloaded, but must be put in the site-init.el file and
     120             : ;; not the site-load.el file in order for the documentation strings for the
     121             : ;; functions being overloaded to be available.
     122             : 
     123             : ;; Status reports:
     124             : ;;
     125             : ;; Most ange-ftp commands that talk to the FTP process output a status
     126             : ;; message on what they are doing.  In addition, ange-ftp can take advantage
     127             : ;; of the FTP client's HASH command to display the status of transferring
     128             : ;; files and listing directories.  See the documentation for the variables
     129             : ;; ange-ftp-{ascii,binary}-hash-mark-size, ange-ftp-send-hash and
     130             : ;; ange-ftp-process-verbose for more details.
     131             : 
     132             : ;; Gateways:
     133             : ;;
     134             : ;; Sometimes it is necessary for the FTP process to be run on a different
     135             : ;; machine than the machine running GNU Emacs.  This can happen when the
     136             : ;; local machine has restrictions on what hosts it can access.
     137             : ;;
     138             : ;; ange-ftp has support for running the ftp process on a different (gateway)
     139             : ;; machine.  The way it works is as follows:
     140             : ;;
     141             : ;; 1) Set the variable 'ange-ftp-gateway-host' to the name of a machine
     142             : ;;    that doesn't have the access restrictions.
     143             : ;;
     144             : ;; 2) Set the variable 'ange-ftp-local-host-regexp' to a regular expression
     145             : ;;    that matches hosts that can be contacted from running a local ftp
     146             : ;;    process, but fails to match hosts that can't be accessed locally.  For
     147             : ;;    example:
     148             : ;;
     149             : ;;    "\\.hp\\.com$\\|^[^.]*$"
     150             : ;;
     151             : ;;    will match all hosts that are in the .hp.com domain, or don't have an
     152             : ;;    explicit domain in their name, but will fail to match hosts with
     153             : ;;    explicit domains or that are specified by their ip address.
     154             : ;;
     155             : ;; 3) Using NFS and symlinks, make sure that there is a shared directory with
     156             : ;;    the *same* name between the local machine and the gateway machine.
     157             : ;;    This directory is necessary for temporary files created by ange-ftp.
     158             : ;;
     159             : ;; 4) Set the variable 'ange-ftp-gateway-tmp-name-template' to the name of
     160             : ;;    this directory plus an identifying filename prefix.  For example:
     161             : ;;
     162             : ;;    "/nfs/hplose/ange/ange-ftp"
     163             : ;;
     164             : ;;    where /nfs/hplose/ange is a directory that is shared between the
     165             : ;;    gateway machine and the local machine.
     166             : ;;
     167             : ;; The simplest way of getting a ftp process running on the gateway machine
     168             : ;; is if you can spawn a remote shell using either 'rsh' or 'remsh'.  If you
     169             : ;; can't do this for some reason such as security then points 7 onwards will
     170             : ;; discuss an alternative approach.
     171             : ;;
     172             : ;; 5) Set the variable ange-ftp-gateway-program to the name of the remote
     173             : ;;    shell process such as 'remsh' or 'rsh' if the default isn't correct.
     174             : ;;
     175             : ;; 6) Set the variable ange-ftp-gateway-program-interactive to nil if it
     176             : ;;    isn't already.  This tells ange-ftp that you are using a remote shell
     177             : ;;    rather than logging in using telnet or rlogin.
     178             : ;;
     179             : ;; That should be all you need to allow ange-ftp to spawn a ftp process on
     180             : ;; the gateway machine.  If you have to use telnet or rlogin to get to the
     181             : ;; gateway machine then follow the instructions below.
     182             : ;;
     183             : ;; 7) Set the variable ange-ftp-gateway-program to the name of the program
     184             : ;;    that lets you log onto the gateway machine.  This may be something like
     185             : ;;    telnet or rlogin.
     186             : ;;
     187             : ;; 8) Set the variable ange-ftp-gateway-prompt-pattern to a regular
     188             : ;;    expression that matches the prompt you get when you login to the
     189             : ;;    gateway machine.  Be very specific here; this regexp must not match
     190             : ;;    *anything* in your login banner except this prompt.
     191             : ;;    shell-prompt-pattern is far too general as it appears to match some
     192             : ;;    login banners from Sun machines.  For example:
     193             : ;;
     194             : ;;    "^$*$ *"
     195             : ;;
     196             : ;; 9) Set the variable ange-ftp-gateway-program-interactive to t to let
     197             : ;;    ange-ftp know that it has to "hand-hold" the login to the gateway
     198             : ;;    machine.
     199             : ;;
     200             : ;; 10) Set the variable ange-ftp-gateway-setup-term-command to a UNIX command
     201             : ;;     that will put the pty connected to the gateway machine into a
     202             : ;;     no-echoing mode, and will strip off carriage-returns from output from
     203             : ;;     the gateway machine.  For example:
     204             : ;;
     205             : ;;     "stty -onlcr -echo"
     206             : ;;
     207             : ;;     will work on HP-UX machines, whereas:
     208             : ;;
     209             : ;;     "stty -echo nl"
     210             : ;;
     211             : ;;     appears to work for some Sun machines.
     212             : ;;
     213             : ;; That's all there is to it.
     214             : 
     215             : ;; Smart gateways:
     216             : ;;
     217             : ;; If you have a "smart" ftp program that allows you to issue commands like
     218             : ;; "USER foo@bar" which do nice proxy things, then look at the variables
     219             : ;; ange-ftp-smart-gateway and ange-ftp-smart-gateway-port.
     220             : ;;
     221             : ;; Otherwise, if there is an alternate ftp program that implements proxy in
     222             : ;; a transparent way (i.e. w/o specifying the proxy host), that will
     223             : ;; connect you directly to the desired destination host:
     224             : ;; Set ange-ftp-gateway-ftp-program-name to that program's name.
     225             : ;; Set ange-ftp-local-host-regexp to a value as stated earlier on.
     226             : ;; Leave ange-ftp-gateway-host set to nil.
     227             : ;; Set ange-ftp-smart-gateway to t.
     228             : 
     229             : ;; Tips for using ange-ftp:
     230             : ;;
     231             : ;; 1. For dired to work on a host which marks symlinks with a trailing @ in
     232             : ;;    an ls -alF listing, you need to (setq dired-ls-F-marks-symlinks t).
     233             : ;;    Most UNIX systems do not do this, but ULTRIX does. If you think that
     234             : ;;    there is a chance you might connect to an ULTRIX machine (such as
     235             : ;;    prep.ai.mit.edu), then set this variable accordingly.  This will have
     236             : ;;    the side effect that dired will have problems with symlinks whose names
     237             : ;;    end in an @.  If you get yourself into this situation then editing
     238             : ;;    dired's ls-switches to remove "F", will temporarily fix things.
     239             : ;;
     240             : ;; 2. If you know that you are connecting to a certain non-UNIX machine
     241             : ;;    frequently, and ange-ftp seems to be unable to guess its host-type,
     242             : ;;    then setting the appropriate host-type regexp
     243             : ;;    (ange-ftp-vms-host-regexp, ange-ftp-mts-host-regexp, or
     244             : ;;    ange-ftp-cms-host-regexp) accordingly should help. Also, please report
     245             : ;;    ange-ftp's inability to recognize the host-type as a bug.
     246             : ;;
     247             : ;; 3. For slow connections, you might get "listing unreadable" error
     248             : ;;    messages, or get an empty buffer for a file that you know has something
     249             : ;;    in it. The solution is to increase the value of ange-ftp-retry-time.
     250             : ;;    Its default value is 5 which is plenty for reasonable connections.
     251             : ;;    However, for some transatlantic connections I set this to 20.
     252             : ;;
     253             : ;; 4. Beware of compressing files on non-UNIX hosts. Ange-ftp will do it by
     254             : ;;    copying the file to the local machine, compressing it there, and then
     255             : ;;    sending it back. Binary file transfers between machines of different
     256             : ;;    architectures can be a risky business. Test things out first on some
     257             : ;;    test files. See "Bugs" below. Also, note that ange-ftp copies files by
     258             : ;;    moving them through the local machine. Again, be careful when doing
     259             : ;;    this with binary files on non-Unix machines.
     260             : ;;
     261             : ;; 5. Beware that dired over ftp will use your setting of dired-no-confirm
     262             : ;;    (list of dired commands for which confirmation is not asked).  You
     263             : ;;    might want to reconsider your setting of this variable, because you
     264             : ;;    might want confirmation for more commands on remote direds than on
     265             : ;;    local direds. For example, I strongly recommend that you not include
     266             : ;;    compress and uncompress in this list. If there is enough demand it
     267             : ;;    might be a good idea to have an alist ange-ftp-dired-no-confirm of
     268             : ;;    pairs ( TYPE . LIST ), where TYPE is an operating system type and LIST
     269             : ;;    is a list of commands for which confirmation would be suppressed.  Then
     270             : ;;    remote dired listings would take their (buffer-local) value of
     271             : ;;    dired-no-confirm from this alist. Who votes for this?
     272             : 
     273             : ;; ---------------------------------------------------------------------
     274             : ;; Non-UNIX support:
     275             : ;; ---------------------------------------------------------------------
     276             : 
     277             : ;; VMS support:
     278             : ;;
     279             : ;; Ange-ftp has full support for VMS hosts.  It should be able to
     280             : ;; automatically recognize any VMS machine. However, if it fails to do
     281             : ;; this, you can use the command ange-ftp-add-vms-host.  Also, you can
     282             : ;; set the variable ange-ftp-vms-host-regexp in your init file.  We
     283             : ;; would be grateful if you would report any failures to automatically
     284             : ;; recognize a VMS host as a bug.
     285             : ;;
     286             : ;; Filename Syntax:
     287             : ;;
     288             : ;; For ease of *implementation*, the user enters the VMS filename syntax in a
     289             : ;; UNIX-y way.  For example:
     290             : ;;  PUB$:[ANONYMOUS.SDSCPUB.NEXT]README.TXT;1
     291             : ;; would be entered as:
     292             : ;;  /PUB$$:/ANONYMOUS/SDSCPUB/NEXT/README.TXT;1
     293             : ;; i.e. to log in as anonymous on ymir.claremont.edu and grab the file:
     294             : ;;  [.CSV.POLICY]RULES.MEM
     295             : ;; you would type:
     296             : ;;  C-x C-f /anonymous@ymir.claremont.edu:CSV/POLICY/RULES.MEM
     297             : ;;
     298             : ;; A valid VMS filename is of the form: FILE.TYPE;##
     299             : ;; where FILE can be up to 39 characters
     300             : ;;       TYPE can be up to 39 characters
     301             : ;;       ## is a version number (an integer between 1 and 32,767)
     302             : ;; Valid characters in FILE and TYPE are A-Z 0-9 _ - $
     303             : ;; $ cannot begin a filename, and - cannot be used as the first or last
     304             : ;; character.
     305             : ;;
     306             : ;; Tips:
     307             : ;; 1. Although VMS is not case sensitive, EMACS running under UNIX is.
     308             : ;;    Therefore, to access a VMS file, you must enter the filename with upper
     309             : ;;    case letters.
     310             : ;; 2. To access the latest version of file under VMS, you use the filename
     311             : ;;    without the ";" and version number. You should always edit the latest
     312             : ;;    version of a file. If you want to edit an earlier version, copy it to a
     313             : ;;    new file first. This has nothing to do with ange-ftp, but is simply
     314             : ;;    good VMS operating practice. Therefore, to edit FILE.TXT;3 (say 3 is
     315             : ;;    latest version), do C-x C-f /ymir.claremont.edu:FILE.TXT. If you
     316             : ;;    inadvertently do C-x C-f /ymir.claremont.edu:FILE.TXT;3, you will find
     317             : ;;    that VMS will not allow you to save the file because it will refuse to
     318             : ;;    overwrite FILE.TXT;3, but instead will want to create FILE.TXT;4, and
     319             : ;;    attach the buffer to this file. To get out of this situation, M-x
     320             : ;;    write-file /ymir.claremont.edu:FILE.TXT will attach the buffer to
     321             : ;;    latest version of the file. For this reason, in dired "f"
     322             : ;;    (dired-find-file), always loads the file sans version, whereas "v",
     323             : ;;    (dired-view-file), always loads the explicit version number. The
     324             : ;;    reasoning being that it reasonable to view old versions of a file, but
     325             : ;;    not to edit them.
     326             : ;; 3. EMACS has a feature in which it does environment variable substitution
     327             : ;;    in filenames. Therefore, to enter a $ in a filename, you must quote it
     328             : ;;    by typing $$.
     329             : 
     330             : ;; MTS support:
     331             : ;;
     332             : ;; Ange-ftp has full support for hosts running
     333             : ;; the Michigan terminal system.  It should be able to automatically
     334             : ;; recognize any MTS machine. However, if it fails to do this, you can use
     335             : ;; the command ange-ftp-add-mts-host.  As well, you can set the variable
     336             : ;; ange-ftp-mts-host-regexp in your init file. We would be grateful if you
     337             : ;; would report any failures to automatically recognize a MTS host as a bug.
     338             : ;;
     339             : ;; Filename syntax:
     340             : ;;
     341             : ;; MTS filenames are entered in a UNIX-y way. For example, if your account
     342             : ;; was YYYY, the file FILE in the account XXXX: on mtsg.ubc.ca would be
     343             : ;; entered as
     344             : ;;   /YYYY@mtsg.ubc.ca:/XXXX:/FILE
     345             : ;; In other words, MTS accounts are treated as UNIX directories. Of course,
     346             : ;; to access a file in another account, you must have access permission for
     347             : ;; it.  If FILE were in your own account, then you could enter it in a
     348             : ;; relative name fashion as
     349             : ;;   /YYYY@mtsg.ubc.ca:FILE
     350             : ;; MTS filenames can be up to 12 characters. Like UNIX, the structure of the
     351             : ;; filename does not contain a TYPE (i.e. it can have as many "."'s as you
     352             : ;; like.) MTS filenames are always in upper case, and hence be sure to enter
     353             : ;; them as such! MTS is not case sensitive, but an EMACS running under UNIX
     354             : ;; is.
     355             : 
     356             : ;; CMS support:
     357             : ;;
     358             : ;; Ange-ftp has full support for hosts running
     359             : ;; CMS.  It should be able to automatically recognize any CMS machine.
     360             : ;; However, if it fails to do this, you can use the command
     361             : ;; ange-ftp-add-cms-host.  As well, you can set the variable
     362             : ;; ange-ftp-cms-host-regexp in your init file. We would be grateful if you
     363             : ;; would report any failures to automatically recognize a CMS host as a bug.
     364             : ;;
     365             : ;; Filename syntax:
     366             : ;;
     367             : ;; CMS filenames are entered in a UNIX-y way. In other words, minidisks are
     368             : ;; treated as UNIX directories. For example to access the file READ.ME in
     369             : ;; minidisk *.311 on cuvmb.cc.columbia.edu, you would enter
     370             : ;;   /anonymous@cuvmb.cc.columbia.edu:/*.311/READ.ME
     371             : ;; If *.301 is the default minidisk for this account, you could access
     372             : ;; FOO.BAR on this minidisk as
     373             : ;;   /anonymous@cuvmb.cc.columbia.edu:FOO.BAR
     374             : ;; CMS filenames are of the form FILE.TYPE, where both FILE and TYPE can be
     375             : ;; up to 8 characters. Again, beware that CMS filenames are always upper
     376             : ;; case, and hence must be entered as such.
     377             : ;;
     378             : ;; Tips:
     379             : ;; 1. CMS machines, with the exception of anonymous accounts, nearly always
     380             : ;;    need an account password. To have ange-ftp send an account password,
     381             : ;;    you can either include it in your .netrc file, or use
     382             : ;;    ange-ftp-set-account.
     383             : ;; 2. Ange-ftp cannot send "write passwords" for a minidisk. Hopefully, we
     384             : ;;    can fix this.
     385             : ;;
     386             : ;; BS2000 support:
     387             : ;;
     388             : ;; Ange-ftp has full support for BS2000 hosts.  It should be able to
     389             : ;; automatically recognize any BS2000 machine. However, if it fails to
     390             : ;; do this, you can use the command ange-ftp-add-bs2000-host.  As well,
     391             : ;; you can set the variable ange-ftp-bs2000-host-regexp in your .emacs
     392             : ;; file. We would be grateful if you would report any failures to auto-
     393             : ;; matically recognize a BS2000 host as a bug.
     394             : ;;
     395             : ;; If you want to access the POSIX subsystem on BS2000 you MUST use
     396             : ;; command ange-ftp-add-bs2000-posix-host for that particular
     397             : ;; hostname.  ange-ftp can't decide if you want to access the native
     398             : ;; filesystem or the POSIX filesystem, so it accesses the native
     399             : ;; filesystem by default.  And if you have an ASCII filesystem in
     400             : ;; your BS2000 POSIX subsystem you must use
     401             : ;; ange-ftp-binary-file-name-regexp to access its files.
     402             : ;;
     403             : ;; Filename Syntax:
     404             : ;;
     405             : ;; For ease of *implementation*, the user enters the BS2000 filename
     406             : ;; syntax in a UNIX-y way.  For example:
     407             : ;;  :PUB:$PUBLIC.ANONYMOUS.SDSCPUB.NEXT.README.TXT
     408             : ;; would be entered as:
     409             : ;;  /:PUB:/$$PUBLIC/ANONYMOUS.SDSCPUB.NEXT.README.TXT
     410             : ;; You don't have to type pubset and account, if they have default values,
     411             : ;; i.e. to log in as anonymous on bs2000.anywhere.com and grab the file
     412             : ;; IMPORTANT.TEXT.ON.BS2000 on the default pubset X on userid PUBLIC
     413             : ;; (there are only 8 characters in a valid username), you could type:
     414             : ;;  C-x C-f /public@bs2000.anywhere.com:/IMPORTANT.TEXT.ON.BS2000
     415             : ;; or
     416             : ;;  C-x C-f /anonym@bs2000.anywhere.com:/:X:/$$PUBLIC/IMPORTANT.TEXT.ON.BS2000
     417             : ;;
     418             : ;; If X is not your default pubset, you could add it as 'subdirectory' (BS2000
     419             : ;; has a flat architecture) with the command
     420             : ;; (setq ange-ftp-bs2000-additional-pubsets '(":X:"))
     421             : ;; and then you could type:
     422             : ;;  C-x C-f /anonym@bs2000.anywhere.com:/:X:/IMPORTANT.TEXT.ON.BS2000
     423             : ;;
     424             : ;; Valid characters in an BS2000 filename are A-Z 0-9 $ # @ . -
     425             : ;; If the first character in a filename is # or @, this is replaced with
     426             : ;; ange-ftp-bs2000-special-prefix because names starting with # or @
     427             : ;; are reserved for temporary files.
     428             : ;; This is especially important for auto-save files.
     429             : ;; Valid file generations are ending with ([+|-|*]0-9...) .
     430             : ;; File generations are not supported yet!
     431             : ;; A filename must at least contain one character (A-Z) and cannot be longer
     432             : ;; than 41 characters.
     433             : ;;
     434             : ;; Tips:
     435             : ;; 1. Although BS2000 is not case sensitive, EMACS running under UNIX is.
     436             : ;;    Therefore, to access a BS2000 file, you must enter the filename with
     437             : ;;    upper case letters.
     438             : ;; 2. EMACS has a feature in which it does environment variable substitution
     439             : ;;    in filenames. Therefore, to enter a $ in a filename, you must quote it
     440             : ;;    by typing $$.
     441             : ;; 3. BS2000 machines, with the exception of anonymous accounts, nearly
     442             : ;;    always need an account password. To have ange-ftp send an account
     443             : ;;    password, you can either include it in your .netrc file, or use
     444             : ;;    ange-ftp-set-account.
     445             : ;;
     446             : ;; ------------------------------------------------------------------
     447             : ;; Bugs:
     448             : ;; ------------------------------------------------------------------
     449             : ;;
     450             : ;; 1. Umask problems:
     451             : ;;    Be warned that files created by using ange-ftp will take account of the
     452             : ;;    umask of the ftp daemon process rather than the umask of the creating
     453             : ;;    user.  This is particularly important when logging in as the root user.
     454             : ;;    The way that I tighten up the ftp daemon's umask under HP-UX is to make
     455             : ;;    sure that the umask is changed to 027 before I spawn /etc/inetd.  I
     456             : ;;    suspect that there is something similar on other systems.
     457             : ;;
     458             : ;; 2. Some combinations of FTP clients and servers break and get out of sync
     459             : ;;    when asked to list a non-existent directory.  Some of the ai.mit.edu
     460             : ;;    machines cause this problem for some FTP clients. Using
     461             : ;;    ange-ftp-kill-ftp-process can restart the ftp process, which
     462             : ;;    should get things back in sync.
     463             : ;;
     464             : ;; 3. Ange-ftp does not check to make sure that when creating a new file,
     465             : ;;    you provide a valid filename for the remote operating system.
     466             : ;;    If you do not, then the remote FTP server will most likely
     467             : ;;    translate your filename in some way. This may cause ange-ftp to
     468             : ;;    get confused about what exactly is the name of the file. The
     469             : ;;    most common causes of this are using lower case filenames on systems
     470             : ;;    which support only upper case, and using filenames which are too
     471             : ;;    long.
     472             : ;;
     473             : ;; 4. Null (blank) passwords confuse both ange-ftp and some FTP daemons.
     474             : ;;
     475             : ;; 5. Ange-ftp likes to use pty's to talk to its FTP processes.  If GNU Emacs
     476             : ;;    for some reason creates a FTP process that only talks via pipes then
     477             : ;;    ange-ftp won't be getting the information it requires at the time that
     478             : ;;    it wants it since pipes flush at different times to pty's.  One
     479             : ;;    disgusting way around this problem is to talk to the FTP process via
     480             : ;;    rlogin which does the 'right' things with pty's.
     481             : ;;
     482             : ;; 6. For CMS support, we send too many cd's. Since cd's are cheap, I haven't
     483             : ;;    worried about this too much. Eventually, we should have some caching
     484             : ;;    of the current minidisk.
     485             : ;;
     486             : ;; 7. Some CMS machines do not assign a default minidisk when you ftp them as
     487             : ;;    anonymous. It is then necessary to guess a valid minidisk name, and cd
     488             : ;;    to it. This is (understandably) beyond ange-ftp.
     489             : ;;
     490             : ;; 8. Remote to remote copying of files on non-Unix machines can be risky.
     491             : ;;    Depending on the variable ange-ftp-binary-file-name-regexp, ange-ftp
     492             : ;;    will use binary mode for the copy. Between systems of different
     493             : ;;    architecture, this still may not be enough to guarantee the integrity
     494             : ;;    of binary files. Binary file transfers from VMS machines are
     495             : ;;    particularly problematical. Should ange-ftp-binary-file-name-regexp be
     496             : ;;    an alist of OS type, regexp pairs?
     497             : ;;
     498             : ;; 9. The code to do compression of files over ftp is not as careful as it
     499             : ;;    should be. It deletes the old remote version of the file, before
     500             : ;;    actually checking if the local to remote transfer of the compressed
     501             : ;;    file succeeds. Of course to delete the original version of the file
     502             : ;;    after transferring the compressed version back is also dangerous,
     503             : ;;    because some OS's have severe restrictions on the length of filenames,
     504             : ;;    and when the compressed version is copied back the "-Z" or ".Z" may be
     505             : ;;    truncated. Then, ange-ftp would delete the only remaining version of
     506             : ;;    the file.  Maybe ange-ftp should make backups when it compresses files
     507             : ;;    (of course, the backup "~" could also be truncated off, sigh...).
     508             : ;;    Suggestions?
     509             : ;;
     510             : ;; 10. If a dir listing is attempted for an empty directory on (at least
     511             : ;;     some) VMS hosts, an ftp error is given. This is really an ftp bug, and
     512             : ;;     I don't know how to get ange-ftp work to around it.
     513             : ;;
     514             : ;; 11. Bombs on filenames that start with a space. Deals well with filenames
     515             : ;;     containing spaces, but beware that the remote ftpd may not like them
     516             : ;;     much.
     517             : ;;
     518             : ;; 12. The dired support for non-Unix-like systems does not currently work.
     519             : ;;     It needs to be reimplemented by modifying the parse-...-listing
     520             : ;;      functions to convert the directory listing to ls -l format.
     521             : ;;
     522             : ;; 13. The famous @ bug. As mentioned above in TIPS, ULTRIX marks symlinks
     523             : ;;     with a trailing @ in a ls -alF listing. In order to account for this
     524             : ;;     ange-ftp looks to chop trailing @'s off of symlink names when it is
     525             : ;;     parsing a listing with the F switch. This will cause ange-ftp to
     526             : ;;     incorrectly get the name of a symlink on a non-ULTRIX host if its name
     527             : ;;     ends in an @. ange-ftp will correct itself if you take F out of the
     528             : ;;     dired ls switches (C-u s will allow you to edit the switches). The
     529             : ;;     dired buffer will be automatically reverted, which will allow ange-ftp
     530             : ;;     to fix its files hashtable.  A cookie to anyone who can think of a
     531             : ;;     fast, sure-fire way to recognize ULTRIX over ftp.
     532             : 
     533             : ;; If you find any bugs or problems with this package, PLEASE report a
     534             : ;; bug to the Emacs maintainers via M-x report-emacs-bug.
     535             : 
     536             : ;; -----------------------------------------------------------
     537             : ;; Technical information on this package:
     538             : ;; -----------------------------------------------------------
     539             : 
     540             : ;; ange-ftp works by putting a handler on file-name-handler-alist
     541             : ;; which is called by many primitives, and a few non-primitives,
     542             : ;; whenever they see a file name of the appropriate sort.
     543             : 
     544             : ;; Checklist for adding non-UNIX support for TYPE
     545             : ;;
     546             : ;; The following functions may need TYPE versions:
     547             : ;; (not all functions will be needed for every OS)
     548             : ;;
     549             : ;; ange-ftp-fix-name-for-TYPE
     550             : ;; ange-ftp-fix-dir-name-for-TYPE
     551             : ;; ange-ftp-TYPE-host
     552             : ;; ange-ftp-TYPE-add-host
     553             : ;; ange-ftp-parse-TYPE-listing
     554             : ;; ange-ftp-TYPE-delete-file-entry
     555             : ;; ange-ftp-TYPE-add-file-entry
     556             : ;; ange-ftp-TYPE-file-name-as-directory
     557             : ;; ange-ftp-TYPE-make-compressed-filename
     558             : ;; ange-ftp-TYPE-file-name-sans-versions
     559             : ;;
     560             : ;; Variables:
     561             : ;;
     562             : ;; ange-ftp-TYPE-host-regexp
     563             : ;; May need to add TYPE to ange-ftp-dumb-host-types
     564             : ;;
     565             : ;; Check the following functions for OS dependent coding:
     566             : ;;
     567             : ;; ange-ftp-host-type
     568             : ;; ange-ftp-guess-host-type
     569             : ;; ange-ftp-allow-child-lookup
     570             : 
     571             : ;; Host type conventions:
     572             : ;;
     573             : ;; The function ange-ftp-host-type and the variable ange-ftp-dired-host-type
     574             : ;; (mostly) follow the following conventions for remote host types.  At
     575             : ;; least, I think that future code should try to follow these conventions,
     576             : ;; and the current code should eventually be made compliant.
     577             : ;;
     578             : ;; nil = local host type, whatever that is (probably unix).
     579             : ;;       Think nil as in "not a remote host". This value is used by
     580             : ;;       ange-ftp-dired-host-type for local buffers.
     581             : ;;
     582             : ;; t = a remote host of unknown type. Think t as in true, it's remote.
     583             : ;;     Currently, `unix' is used as the default remote host type.
     584             : ;;     Maybe we should use t.
     585             : ;;
     586             : ;; TYPE = a remote host of TYPE type.
     587             : ;;
     588             : ;; TYPE:LIST = a remote host of TYPE type, using a specialized ftp listing
     589             : ;;             program called list. This is currently only used for Unix
     590             : ;;             dl (descriptive listings), when ange-ftp-dired-host-type
     591             : ;;             is set to `unix:dl'.
     592             : 
     593             : ;; Bug report codes:
     594             : ;;
     595             : ;; Because of their naive faith in this code, there are certain situations
     596             : ;; which the writers of this program believe could never happen. However,
     597             : ;; being realists they have put calls to `error' in the program at these
     598             : ;; points. These errors provide a code, which is an integer, greater than 1.
     599             : ;; To aid debugging.  the error codes, and the functions in which they reside
     600             : ;; are listed below.
     601             : ;;
     602             : ;; 1: See ange-ftp-ls
     603             : ;;
     604             : 
     605             : ;; -----------------------------------------------------------
     606             : ;; Hall of fame:
     607             : ;; -----------------------------------------------------------
     608             : ;;
     609             : ;; Thanks to Roland McGrath for improving the filename syntax handling,
     610             : ;; for suggesting many enhancements and for numerous cleanups to the code.
     611             : ;;
     612             : ;; Thanks to Jamie Zawinski for bugfixes and for ideas such as gateways.
     613             : ;;
     614             : ;; Thanks to Ken Laprade for improved .netrc parsing, password reading, and
     615             : ;; dired / shell auto-loading.
     616             : ;;
     617             : ;; Thanks to Sebastian Kremer for dired support and for many ideas and
     618             : ;; bugfixes.
     619             : ;;
     620             : ;; Thanks to Joe Wells for bugfixes, the original non-UNIX system support,
     621             : ;; VOS support, and hostname completion.
     622             : ;;
     623             : ;; Thanks to Nakagawa Takayuki for many good ideas, filename-completion, help
     624             : ;; with file-name expansion, efficiency worries, stylistic concerns and many
     625             : ;; bugfixes.
     626             : ;;
     627             : ;; Thanks to Sandy Rutherford who re-wrote most of ange-ftp to support VMS,
     628             : ;; MTS, CMS and UNIX-dls.  Sandy also added dired-support for non-UNIX OS and
     629             : ;; auto-recognition of the host type.
     630             : ;;
     631             : ;; Thanks to Dave Smith who wrote the info file for ange-ftp.
     632             : ;;
     633             : ;; Finally, thanks to Keith Waclena, Mark D. Baushke, Terence Kelleher, Ping
     634             : ;; Zhou, Edward Vielmetti, Jack Repenning, Mike Balenger, Todd Kaufmann,
     635             : ;; Kjetil Svarstad, Tom Wurgler, Linus Tolke, Niko Makila, Carl Edman, Bill
     636             : ;; Trost, Dave Brennan, Dan Jacobson, Andy Scott, Steve Anderson, Sanjay
     637             : ;; Mathur, the folks on the ange-ftp-lovers mailing list and many others
     638             : ;; whose names I've forgotten who have helped to debug and fix problems with
     639             : ;; ange-ftp.el.
     640             : 
     641             : ;;; Code:
     642             : 
     643             : (require 'comint)
     644             : 
     645             : ;;;; ------------------------------------------------------------
     646             : ;;;; User customization variables.
     647             : ;;;; ------------------------------------------------------------
     648             : 
     649             : (defgroup ange-ftp nil
     650             :   "Accessing remote files and directories using FTP."
     651             :   :group 'files
     652             :   :group 'comm
     653             :   :prefix "ange-ftp-")
     654             : 
     655             : (defcustom ange-ftp-name-format
     656             :   '("\\`/\\(\\([^/:]*\\)@\\)?\\([^@/:]*[^@/:.]\\):\\(.*\\)" . (3 2 4))
     657             :   "Format of a fully expanded remote file name.
     658             : 
     659             : This is a list of the form \(REGEXP HOST USER NAME),
     660             : where REGEXP is a regular expression matching
     661             : the full remote name, and HOST, USER, and NAME are the numbers of
     662             : parenthesized expressions in REGEXP for the components (in that order)."
     663             :   :group 'ange-ftp
     664             :   :type '(list (regexp  :tag "Name regexp")
     665             :                (integer :tag "Host group")
     666             :                (integer :tag "User group")
     667             :                (integer :tag "Name group")))
     668             : 
     669             : ;; ange-ftp-multi-skip-msgs should only match ###-, where ### is one of
     670             : ;; the number codes corresponding to ange-ftp-good-msgs or ange-ftp-fatal-msgs.
     671             : ;; Otherwise, ange-ftp will go into multi-skip mode, and never come out.
     672             : 
     673             : (defvar ange-ftp-multi-msgs
     674             :   "^150-\\|^220-\\|^230-\\|^226\\|^25.-\\|^221-\\|^200-\\|^331-\\|^4[25]1-\\|^530-"
     675             :   "Regular expression matching the start of a multiline FTP reply.")
     676             : 
     677             : (defvar ange-ftp-good-msgs
     678             :   "^220 \\|^230 \\|^226 \\|^25. \\|^221 \\|^200 \\|^[Hh]ash mark\\|^Remote directory:"
     679             :   "Regular expression matching FTP \"success\" messages.")
     680             : 
     681             : ;; CMS and the odd VMS machine say 200 Port rather than 200 PORT.
     682             : ;; Also CMS machines use a multiline 550- reply to say that you
     683             : ;; don't have write permission. ange-ftp gets into multi-line skip
     684             : ;; mode and hangs. Have it ignore 550- instead. It will then barf
     685             : ;; when it gets the 550 line, as it should.
     686             : 
     687             : ;; RFC2228 "FTP Security Extensions" defines extensions to the FTP
     688             : ;; protocol which involve the client requesting particular
     689             : ;; authentication methods (typically) at connection establishment. Non
     690             : ;; security-aware FTP servers should respond to this with a 500 code,
     691             : ;; which we ignore.
     692             : 
     693             : ;; Further messages are needed to support ftp-ssl.
     694             : (defcustom ange-ftp-skip-msgs
     695             :   (concat "^200 \\(PORT\\|Port\\) \\|^331 \\|^150 \\|^350 \\|^[0-9]+ bytes \\|"
     696             :           "^Connected \\|^$\\|^Remote system\\|^Using\\|^ \\|Password:\\|"
     697             :           "^Data connection \\|"
     698             :           "^200 PBSZ\\|" "^200 Protection set to Private\\|"
     699             :           "^234 AUTH TLS successful\\|"
     700             :           "^SSL not available\\|"
     701             :           "^\\[SSL Cipher .+\\]\\|"
     702             :           "^\\[Encrypted data transfer\\.\\]\\|"
     703             :           "^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye\\|"
     704             :           "^500 .*AUTH\\|^KERBEROS\\|"
     705             :           "^500 This security scheme is not implemented\\|"
     706             :           "^504 Unknown security mechanism\\|"
     707             :           "^530 Please login with USER and PASS\\|" ; non kerberized vsFTPd
     708             :           "^534 Kerberos Authentication not enabled\\|"
     709             :           "^22[789] .*[Pp]assive\\|^200 EPRT\\|^500 .*EPRT\\|^500 .*EPSV")
     710             :   "Regular expression matching FTP messages that can be ignored."
     711             :   :group 'ange-ftp
     712             :   :version "26.1"
     713             :   :type 'regexp)
     714             : 
     715             : (defcustom ange-ftp-fatal-msgs
     716             :   (concat "^ftp: \\|^Not connected\\|^530 \\|^4[25]1 \\|rcmd: \\|"
     717             :           "^No control connection\\|unknown host\\|^lost connection")
     718             :   "Regular expression matching FTP messages that indicate serious errors.
     719             : 
     720             : These mean that the FTP process should be (or already has been) killed."
     721             :   :group 'ange-ftp
     722             :   :type 'regexp)
     723             : 
     724             : (defcustom ange-ftp-potential-error-msgs
     725             :   ;; On macOS we sometimes get things like:
     726             :   ;;
     727             :   ;;     ftp> open ftp.nluug.nl
     728             :   ;;     Trying 2001:610:1:80aa:192:87:102:36...
     729             :   ;;     ftp: connect to address 2001:610:1:80aa:192:87:102:36: No route to host
     730             :   ;;     Trying 192.87.102.36...
     731             :   ;;     Connected to ftp.nluug.nl.
     732             :   "^ftp: connect to address .*: No route to host"
     733             :   "Regular expression matching FTP messages that can indicate serious errors.
     734             : These mean that something went wrong, but they may be followed by more
     735             : messages indicating that the error was somehow corrected."
     736             :   :group 'ange-ftp
     737             :   :type 'regexp)
     738             : 
     739             : (defcustom ange-ftp-gateway-fatal-msgs
     740             :   "No route to host\\|Connection closed\\|No such host\\|Login incorrect"
     741             :   "Regular expression matching login failure messages from rlogin/telnet."
     742             :   :group 'ange-ftp
     743             :   :type 'regexp)
     744             : 
     745             : (defcustom ange-ftp-xfer-size-msgs
     746             :   "^150 .* connection for .* (\\([0-9]+\\) bytes)"
     747             :   "Regular expression used to determine the number of bytes in a FTP transfer."
     748             :   :group 'ange-ftp
     749             :   :type 'regexp)
     750             : 
     751             : (defcustom ange-ftp-tmp-name-template
     752             :   (expand-file-name "ange-ftp" temporary-file-directory)
     753             :   "Template used to create temporary files."
     754             :   :group 'ange-ftp
     755             :   :type 'directory)
     756             : 
     757             : (defcustom ange-ftp-gateway-tmp-name-template "/tmp/ange-ftp"
     758             :   "Template used to create temporary files when FTP-ing through a gateway.
     759             : 
     760             : Files starting with this prefix need to be accessible from BOTH the local
     761             : machine and the gateway machine, and need to have the SAME name on both
     762             : machines, that is, /tmp is probably NOT what you want, since that is rarely
     763             : cross-mounted."
     764             :   :group 'ange-ftp
     765             :   :type 'directory)
     766             : 
     767             : (defcustom ange-ftp-netrc-filename "~/.netrc"
     768             :   "File in .netrc format to search for passwords."
     769             :   :group 'ange-ftp
     770             :   :type 'file)
     771             : 
     772             : (defcustom ange-ftp-disable-netrc-security-check (eq system-type 'windows-nt)
     773             :   "If non-nil avoid checking permissions on the .netrc file."
     774             :   :group 'ange-ftp
     775             :   :type 'boolean)
     776             : 
     777             : (defcustom ange-ftp-default-user nil
     778             :   "User name to use when none is specified in a file name.
     779             : 
     780             : If non-nil but not a string, you are prompted for the name.
     781             : If nil, the value of `ange-ftp-netrc-default-user' is used.
     782             : If that is nil too, then your login name is used.
     783             : 
     784             : Once a connection to a given host has been initiated, the user name
     785             : and password information for that host are cached and re-used by
     786             : ange-ftp.  Use \\[ange-ftp-set-user] to change the cached values,
     787             : since setting `ange-ftp-default-user' directly does not affect
     788             : the cached information."
     789             :   :group 'ange-ftp
     790             :   :type '(choice (const :tag "Default" nil)
     791             :                  string
     792             :                  (other :tag "Prompt" t)))
     793             : 
     794             : (defcustom ange-ftp-netrc-default-user nil
     795             :   "Alternate default user name to use when none is specified.
     796             : 
     797             : This variable is set from the `default' command in your `.netrc' file,
     798             : if there is one."
     799             :   :group 'ange-ftp
     800             :   :type '(choice (const :tag "Default" nil)
     801             :                  string))
     802             : 
     803             : (defcustom ange-ftp-default-password nil
     804             :   "Password to use when the user name equals `ange-ftp-default-user'."
     805             :   :group 'ange-ftp
     806             :   :type '(choice (const :tag "Default" nil)
     807             :                  string))
     808             : 
     809             : (defcustom ange-ftp-default-account nil
     810             :   "Account to use when the user name equals `ange-ftp-default-user'."
     811             :   :group 'ange-ftp
     812             :   :type '(choice (const :tag "Default" nil)
     813             :                  string))
     814             : 
     815             : (defcustom ange-ftp-netrc-default-password nil
     816             :   "Password to use when the user name equals `ange-ftp-netrc-default-user'."
     817             :   :group 'ange-ftp
     818             :   :type '(choice (const :tag "Default" nil)
     819             :                  string))
     820             : 
     821             : (defcustom ange-ftp-netrc-default-account nil
     822             :   "Account to use when the user name equals `ange-ftp-netrc-default-user'."
     823             :   :group 'ange-ftp
     824             :   :type '(choice (const :tag "Default" nil)
     825             :                  string))
     826             : 
     827             : (defcustom ange-ftp-generate-anonymous-password t
     828             :   "If t, use value of `user-mail-address' as password for anonymous FTP.
     829             : 
     830             : If a string, then use that string as the password.
     831             : If nil, prompt the user for a password."
     832             :   :group 'ange-ftp
     833             :   :type '(choice (const :tag "Prompt" nil)
     834             :                  string
     835             :                  (other :tag "User address" t)))
     836             : 
     837             : (defcustom ange-ftp-dumb-unix-host-regexp nil
     838             :   "If non-nil, regexp matching hosts on which `dir' command lists directory."
     839             :   :group 'ange-ftp
     840             :   :type '(choice (const :tag "Default" nil)
     841             :                  string))
     842             : 
     843             : (defcustom ange-ftp-binary-file-name-regexp ""
     844             :   "If a file matches this regexp then it is transferred in binary mode."
     845             :   :group 'ange-ftp
     846             :   :type 'regexp
     847             :   :version "24.1")
     848             : 
     849             : (defcustom ange-ftp-gateway-host nil
     850             :   "Name of host to use as gateway machine when local FTP isn't possible."
     851             :   :group 'ange-ftp
     852             :   :type '(choice (const :tag "Default" nil)
     853             :                  string))
     854             : 
     855             : (defcustom ange-ftp-local-host-regexp ".*"
     856             :   "Regexp selecting hosts which can be reached directly with FTP.
     857             : 
     858             : For other hosts the FTP process is started on `ange-ftp-gateway-host'
     859             : instead, and/or reached via `ange-ftp-gateway-ftp-program-name'."
     860             :   :group 'ange-ftp
     861             :   :type 'regexp)
     862             : 
     863             : (defcustom ange-ftp-gateway-program-interactive nil
     864             :   "If non-nil then the gateway program should give a shell prompt.
     865             : 
     866             : Both telnet and rlogin do something like this."
     867             :   :group 'ange-ftp
     868             :   :type 'boolean)
     869             : 
     870             : (defcustom ange-ftp-gateway-program remote-shell-program
     871             :   "Name of program to spawn a shell on the gateway machine.
     872             : 
     873             : Valid candidates are rsh (remsh on some systems), telnet and rlogin.
     874             : See also the gateway variable above."
     875             :   :group 'ange-ftp
     876             :   :type '(choice (const "rsh")
     877             :                  (const "telnet")
     878             :                  (const "rlogin")
     879             :                  string))
     880             : 
     881             : (defcustom ange-ftp-gateway-prompt-pattern "^[^#$%>;\n]*[#$%>;] *"
     882             :   "Regexp matching prompt after complete login sequence on gateway machine.
     883             : 
     884             : A match for this means the shell is now awaiting input.  Make this regexp as
     885             : strict as possible; it shouldn't match *anything* at all except the user's
     886             : initial prompt.  The above string will fail under most SUN-3's since it
     887             : matches the login banner."
     888             :   :group 'ange-ftp
     889             :   :type 'regexp)
     890             : 
     891             : (defvar ange-ftp-gateway-setup-term-command
     892             :   (if (eq system-type 'hpux)
     893             :       "stty -onlcr -echo\n"
     894             :     "stty -echo nl\n")
     895             :   "Set up terminal after logging in to the gateway machine.
     896             : This command should stop the terminal from echoing each command, and
     897             : arrange to strip out trailing ^M characters.")
     898             : 
     899             : (defcustom ange-ftp-smart-gateway nil
     900             :   "Non-nil says the FTP gateway (proxy) or gateway FTP program is smart.
     901             : 
     902             : Don't bother telnetting, etc., already connected to desired host transparently,
     903             : or just issue a user@host command in case `ange-ftp-gateway-host' is non-nil.
     904             : See also `ange-ftp-smart-gateway-port'."
     905             :   :group 'ange-ftp
     906             :   :type 'boolean)
     907             : 
     908             : (defcustom ange-ftp-smart-gateway-port "21"
     909             :   "Port on gateway machine to use when smart gateway is in operation."
     910             :   :group 'ange-ftp
     911             :   :type 'string)
     912             : 
     913             : (defcustom ange-ftp-send-hash t
     914             :   "If non-nil, send the HASH command to the FTP client."
     915             :   :group 'ange-ftp
     916             :   :type 'boolean)
     917             : 
     918             : (defcustom ange-ftp-binary-hash-mark-size nil
     919             :   "Default size, in bytes, between hash-marks when transferring a binary file.
     920             : If nil, this variable will be locally overridden if the FTP client outputs a
     921             : suitable response to the HASH command.  If non-nil, this value takes
     922             : precedence over the local value."
     923             :   :group 'ange-ftp
     924             :   :type '(choice (const :tag "Overridden" nil)
     925             :                  integer))
     926             : 
     927             : (defcustom ange-ftp-ascii-hash-mark-size 1024
     928             :   "Default size, in bytes, between hash-marks when transferring an ASCII file.
     929             : This variable is buffer-local and will be locally overridden if the FTP client
     930             : outputs a suitable response to the HASH command."
     931             :   :group 'ange-ftp
     932             :   :type 'integer)
     933             : 
     934             : (defcustom ange-ftp-process-verbose t
     935             :   "If non-nil then be chatty about interaction with the FTP process."
     936             :   :group 'ange-ftp
     937             :   :type 'boolean)
     938             : 
     939             : (defcustom ange-ftp-ftp-program-name "ftp"
     940             :   "Name of FTP program to run."
     941             :   :group 'ange-ftp
     942             :   :type 'string)
     943             : 
     944             : (defcustom ange-ftp-gateway-ftp-program-name "ftp"
     945             :   "Name of FTP program to run when accessing non-local hosts.
     946             : 
     947             : Some AT&T folks claim to use something called `pftp' here."
     948             :   :group 'ange-ftp
     949             :   :type 'string)
     950             : 
     951             : (defcustom ange-ftp-ftp-program-args '("-i" "-n" "-g" "-v")
     952             :   "A list of arguments passed to the FTP program when started."
     953             :   :group 'ange-ftp
     954             :   :type '(repeat string))
     955             : 
     956             : (defcustom ange-ftp-nslookup-program nil
     957             :   "If non-nil, this is a string naming the nslookup program."
     958             :   :group 'ange-ftp
     959             :   :type '(choice (const :tag "None" nil)
     960             :                  string))
     961             : 
     962             : (defcustom ange-ftp-make-backup-files ()
     963             :   "Non-nil means make backup files for \"magic\" remote files."
     964             :   :group 'ange-ftp
     965             :   :type 'boolean)
     966             : 
     967             : (defcustom ange-ftp-retry-time 5
     968             :   "Number of seconds to wait before retry if file or listing doesn't arrive.
     969             : This might need to be increased for very slow connections."
     970             :   :group 'ange-ftp
     971             :   :type 'integer)
     972             : 
     973             : (defcustom ange-ftp-auto-save 0
     974             :   "If 1, allow ange-ftp files to be auto-saved.
     975             : If 0, inhibit auto-saving of ange-ftp files.
     976             : Don't use any other value."
     977             :   :group 'ange-ftp
     978             :   :type '(choice (const :tag "Suppress" 0)
     979             :                  (const :tag "Allow" 1)))
     980             : 
     981             : (defcustom ange-ftp-try-passive-mode nil
     982             :   "If t, try to use passive mode in FTP, if the client program supports it."
     983             :   :group 'ange-ftp
     984             :   :type 'boolean
     985             :   :version "21.1")
     986             : 
     987             : (defcustom ange-ftp-passive-host-alist nil
     988             :   "Alist of FTP servers that need \"passive\" mode.
     989             : Each element is of the form (HOSTNAME . SETTING).
     990             : HOSTNAME is a regular expression to match the FTP server host name(s).
     991             : SETTING is \"on\" to turn passive mode on, \"off\" to turn it off,
     992             : or nil meaning don't change it."
     993             :   :group 'ange-ftp
     994             :   :type '(repeat (cons regexp (choice (const :tag "On" "on")
     995             :                                       (const :tag "Off" "off")
     996             :                                       (const :tag "Don't change" nil))))
     997             :   :version "22.1")
     998             : 
     999             : ;;;; ------------------------------------------------------------
    1000             : ;;;; Hash table support.
    1001             : ;;;; ------------------------------------------------------------
    1002             : 
    1003             : (require 'backquote)
    1004             : 
    1005             : (defun ange-ftp-hash-entry-exists-p (key tbl)
    1006             :   "Return whether there is an association for KEY in table TBL."
    1007           0 :   (and tbl (not (eq (gethash key tbl 'unknown) 'unknown))))
    1008             : 
    1009             : (defun ange-ftp-hash-table-keys (tbl)
    1010             :   "Return a sorted list of all the active keys in table TBL, as strings."
    1011             :   ;; (let ((keys nil))
    1012             :   ;;   (maphash (lambda (k v) (push k keys)) tbl)
    1013             :   ;;   (sort keys 'string-lessp))
    1014           0 :   (sort (all-completions "" tbl) 'string-lessp))
    1015             : 
    1016             : ;;;; ------------------------------------------------------------
    1017             : ;;;; Internal variables.
    1018             : ;;;; ------------------------------------------------------------
    1019             : 
    1020             : (defvar ange-ftp-data-buffer-name " *ftp data*"
    1021             :   "Buffer name to hold directory listing data received from FTP process.")
    1022             : 
    1023             : (defvar ange-ftp-netrc-modtime nil
    1024             :   "Last modified time of the netrc file from file-attributes.")
    1025             : 
    1026             : (defvar ange-ftp-user-hashtable (make-hash-table :test 'equal)
    1027             :   "Hash table holding associations between HOST, USER pairs.")
    1028             : 
    1029             : (defvar ange-ftp-passwd-hashtable (make-hash-table :test 'equal)
    1030             :   "Mapping between a HOST, USER pair and a PASSWORD for them.
    1031             : All HOST values should be in lower case.")
    1032             : 
    1033             : (defvar ange-ftp-account-hashtable (make-hash-table :test 'equal)
    1034             :   "Mapping between a HOST, USER pair and an ACCOUNT password for them.")
    1035             : 
    1036             : (defvar ange-ftp-files-hashtable (make-hash-table :test 'equal :size 97)
    1037             :   "Hash table for storing directories and their respective files.")
    1038             : 
    1039             : (defvar ange-ftp-inodes-hashtable (make-hash-table :test 'equal :size 97)
    1040             :   "Hash table for storing file names and their \"inode numbers\".")
    1041             : 
    1042             : (defvar ange-ftp-next-inode-number 1
    1043             :   "Next \"inode number\" value.  We give each file name a unique number.")
    1044             : 
    1045             : (defvar ange-ftp-ls-cache-lsargs nil
    1046             :   "Last set of args used by `ange-ftp-ls'.")
    1047             : 
    1048             : (defvar ange-ftp-ls-cache-file nil
    1049             :   "Last file passed to `ange-ftp-ls'.")
    1050             : 
    1051             : (defvar ange-ftp-ls-cache-res nil
    1052             :   "Last result returned from `ange-ftp-ls'.")
    1053             : 
    1054             : (defconst ange-ftp-expand-dir-hashtable (make-hash-table :test 'equal))
    1055             : 
    1056             : (defconst ange-ftp-expand-dir-regexp "^5.0 \\([^: ]+\\):")
    1057             : 
    1058             : ;; These are local variables in each FTP process buffer.
    1059             : (defvar ange-ftp-hash-mark-unit nil)
    1060             : (defvar ange-ftp-hash-mark-count nil)
    1061             : (defvar ange-ftp-xfer-size nil)
    1062             : (defvar ange-ftp-process-string nil)
    1063             : (defvar ange-ftp-process-result-line nil)
    1064             : (defvar ange-ftp-pending-error-line nil)
    1065             : (defvar ange-ftp-process-busy nil)
    1066             : (defvar ange-ftp-process-result nil)
    1067             : (defvar ange-ftp-process-multi-skip nil)
    1068             : (defvar ange-ftp-process-msg nil)
    1069             : (defvar ange-ftp-process-continue nil)
    1070             : (defvar ange-ftp-last-percent nil)
    1071             : 
    1072             : ;; These variables are bound by one function and examined by another.
    1073             : ;; Leave them void globally for error checking.
    1074             : (defvar ange-ftp-this-file)
    1075             : (defvar ange-ftp-this-dir)
    1076             : (defvar ange-ftp-this-user)
    1077             : (defvar ange-ftp-this-host)
    1078             : (defvar ange-ftp-this-msg)
    1079             : (defvar ange-ftp-completion-ignored-pattern)
    1080             : (defvar ange-ftp-trample-marker)
    1081             : 
    1082             : ;; New error symbols.
    1083             : (define-error 'ftp-error nil 'file-error) ;"FTP error"
    1084             : 
    1085             : ;;; ------------------------------------------------------------
    1086             : ;;; Enhanced message support.
    1087             : ;;; ------------------------------------------------------------
    1088             : 
    1089             : (defun ange-ftp-message (fmt &rest args)
    1090             :   "Display message in echo area, but indicate if truncated.
    1091             : Args are as in `message': a format string, plus arguments to be formatted."
    1092           0 :   (let ((msg (apply #'format-message fmt args))
    1093           0 :         (max (window-width (minibuffer-window))))
    1094           0 :     (if noninteractive
    1095           0 :         msg
    1096           0 :       (if (>= (length msg) max)
    1097             :           ;; Take just the last MAX - 3 chars of the string.
    1098           0 :           (setq msg (concat "> " (substring msg (- 3 max)))))
    1099           0 :       (message "%s" msg))))
    1100             : 
    1101             : (defun ange-ftp-abbreviate-filename (file &optional new)
    1102             :   "Abbreviate the file name FILE relative to the `default-directory'.
    1103             : If the optional parameter NEW is given and the non-directory parts match,
    1104             : only return the directory part of FILE."
    1105           0 :   (save-match-data
    1106           0 :     (if (and default-directory
    1107           0 :              (string-match (concat "\\`"
    1108           0 :                                    (regexp-quote default-directory)
    1109           0 :                                    ".") file))
    1110           0 :         (setq file (substring file (1- (match-end 0)))))
    1111           0 :     (if (and new
    1112           0 :              (string-equal (file-name-nondirectory file)
    1113           0 :                            (file-name-nondirectory new)))
    1114           0 :         (setq file (file-name-directory file)))
    1115           0 :     (or file "./")))
    1116             : 
    1117             : ;;;; ------------------------------------------------------------
    1118             : ;;;; User / Host mapping support.
    1119             : ;;;; ------------------------------------------------------------
    1120             : 
    1121             : (defun ange-ftp-set-user (host user)
    1122             :   "For a given HOST, set or change the default USER."
    1123             :   (interactive "sHost: \nsUser: ")
    1124           1 :   (puthash host user ange-ftp-user-hashtable))
    1125             : 
    1126             : (defun ange-ftp-get-user (host)
    1127             :   "Given a HOST, return the default user."
    1128           1 :   (ange-ftp-parse-netrc)
    1129           1 :   (let ((user (gethash host ange-ftp-user-hashtable)))
    1130           1 :     (or user
    1131           1 :         (prog1
    1132           1 :             (setq user
    1133           1 :                   (cond ((stringp ange-ftp-default-user)
    1134             :                          ;; We have a default name.  Use it.
    1135           0 :                          ange-ftp-default-user)
    1136           1 :                         (ange-ftp-default-user
    1137             :                          ;; Ask the user.
    1138           0 :                          (let ((enable-recursive-minibuffers t))
    1139           0 :                            (read-string (format "User for %s: " host)
    1140           0 :                                         (user-login-name))))
    1141           1 :                         (ange-ftp-netrc-default-user)
    1142             :                         ;; Default to the user's login name.
    1143             :                         (t
    1144           1 :                          (user-login-name))))
    1145           1 :           (ange-ftp-set-user host user)))))
    1146             : 
    1147             : ;;;; ------------------------------------------------------------
    1148             : ;;;; Password support.
    1149             : ;;;; ------------------------------------------------------------
    1150             : 
    1151             : (defmacro ange-ftp-generate-passwd-key (host user)
    1152           6 :   `(and (stringp ,host) (stringp ,user) (concat (downcase ,host) "/" ,user)))
    1153             : 
    1154             : (defmacro ange-ftp-lookup-passwd (host user)
    1155           3 :   `(gethash (ange-ftp-generate-passwd-key ,host ,user)
    1156           3 :             ange-ftp-passwd-hashtable))
    1157             : 
    1158             : (defun ange-ftp-set-passwd (host user password)
    1159             :   "For a given HOST and USER, set or change the associated PASSWORD."
    1160           0 :   (interactive (list (read-string "Host: ")
    1161           0 :                      (read-string "User: ")
    1162           0 :                      (read-passwd "Password: ")))
    1163           0 :   (puthash (ange-ftp-generate-passwd-key host user)
    1164           0 :            password ange-ftp-passwd-hashtable))
    1165             : 
    1166             : (defun ange-ftp-get-host-with-passwd (user)
    1167             :   "Given a USER, return a host we know the password for."
    1168           0 :   (ange-ftp-parse-netrc)
    1169           0 :   (catch 'found-one
    1170           0 :     (maphash
    1171             :      (lambda (host val)
    1172           0 :        (if (ange-ftp-lookup-passwd host user) (throw 'found-one host)))
    1173           0 :      ange-ftp-user-hashtable)
    1174           0 :     (save-match-data
    1175           0 :       (maphash
    1176             :        (lambda (key value)
    1177           0 :          (if (string-match "\\`[^/]*\\(/\\).*\\'" key)
    1178           0 :              (let ((host (substring key 0 (match-beginning 1))))
    1179           0 :                (if (and (string-equal user (substring key (match-end 1)))
    1180           0 :                         value)
    1181           0 :                    (throw 'found-one host)))))
    1182           0 :        ange-ftp-passwd-hashtable))
    1183           0 :     nil))
    1184             : 
    1185             : (defun ange-ftp-get-passwd (host user)
    1186             :   "Return the password for specified HOST and USER, asking user if necessary."
    1187             :   ;; If `non-essential' is non-nil, don't ask for a password.  It will
    1188             :   ;; be caught in Tramp.
    1189           0 :   (when non-essential
    1190           0 :     (throw 'non-essential 'non-essential))
    1191             : 
    1192           0 :   (ange-ftp-parse-netrc)
    1193             : 
    1194             :   ;; look up password in the hash table first; user might have overridden the
    1195             :   ;; defaults.
    1196           0 :   (cond ((ange-ftp-lookup-passwd host user))
    1197             : 
    1198             :         ;; See if default user and password set.
    1199           0 :         ((and (stringp ange-ftp-default-user)
    1200           0 :               ange-ftp-default-password
    1201           0 :               (string-equal user ange-ftp-default-user))
    1202           0 :          ange-ftp-default-password)
    1203             : 
    1204             :         ;; See if default user and password set from .netrc file.
    1205           0 :         ((and (stringp ange-ftp-netrc-default-user)
    1206           0 :               ange-ftp-netrc-default-password
    1207           0 :               (string-equal user ange-ftp-netrc-default-user))
    1208           0 :          ange-ftp-netrc-default-password)
    1209             : 
    1210             :         ;; anonymous ftp password is handled specially since there is an
    1211             :         ;; unwritten rule about how that is used on the Internet.
    1212           0 :         ((and (or (string-equal user "anonymous")
    1213           0 :                   (string-equal user "ftp"))
    1214           0 :               ange-ftp-generate-anonymous-password)
    1215           0 :          (if (stringp ange-ftp-generate-anonymous-password)
    1216           0 :              ange-ftp-generate-anonymous-password
    1217           0 :            user-mail-address))
    1218             : 
    1219             :         ;; see if same user has logged in to other hosts; if so then prompt
    1220             :         ;; with the password that was used there.
    1221             :         (t
    1222           0 :          (let* ((enable-recursive-minibuffers t)
    1223           0 :                 (other (ange-ftp-get-host-with-passwd user))
    1224           0 :                 (passwd (if other
    1225             : 
    1226             :                             ;; found another machine with the same user.
    1227             :                             ;; Try that account.
    1228           0 :                             (read-passwd
    1229           0 :                              (format "passwd for %s@%s (default same as %s@%s): "
    1230           0 :                                      user host user other)
    1231             :                              nil
    1232           0 :                              (ange-ftp-lookup-passwd other user))
    1233             : 
    1234             :                           ;; I give up.  Ask the user for the password.
    1235           0 :                           (read-passwd
    1236           0 :                            (format "Password for %s@%s: " user host)))))
    1237           0 :            (ange-ftp-set-passwd host user passwd)
    1238           0 :            passwd))))
    1239             : 
    1240             : ;;;; ------------------------------------------------------------
    1241             : ;;;; Account support
    1242             : ;;;; ------------------------------------------------------------
    1243             : 
    1244             : ;; Account passwords must be either specified in the .netrc file, or set
    1245             : ;; manually by calling ange-ftp-set-account.  For the moment, ange-ftp doesn't
    1246             : ;; check to see whether the FTP process is actually prompting for an account
    1247             : ;; password.
    1248             : 
    1249             : (defun ange-ftp-set-account (host user account)
    1250             :   "For a given HOST and USER, set or change the associated ACCOUNT password."
    1251           0 :   (interactive (list (read-string "Host: ")
    1252           0 :                      (read-string "User: ")
    1253           0 :                      (read-passwd "Account password: ")))
    1254           0 :   (puthash (ange-ftp-generate-passwd-key host user)
    1255           0 :            account ange-ftp-account-hashtable))
    1256             : 
    1257             : (defun ange-ftp-get-account (host user)
    1258             :   "Given a HOST and USER, return the FTP account."
    1259           0 :   (ange-ftp-parse-netrc)
    1260           0 :   (or (gethash (ange-ftp-generate-passwd-key host user)
    1261           0 :                ange-ftp-account-hashtable)
    1262           0 :       (and (stringp ange-ftp-default-user)
    1263           0 :            (string-equal user ange-ftp-default-user)
    1264           0 :            ange-ftp-default-account)
    1265           0 :       (and (stringp ange-ftp-netrc-default-user)
    1266           0 :            (string-equal user ange-ftp-netrc-default-user)
    1267           0 :            ange-ftp-netrc-default-account)))
    1268             : 
    1269             : ;;;; ------------------------------------------------------------
    1270             : ;;;; ~/.netrc support
    1271             : ;;;; ------------------------------------------------------------
    1272             : 
    1273             : (defun ange-ftp-chase-symlinks (file)
    1274             :   "Return the filename that FILE references, following all symbolic links."
    1275           1 :   (let (temp)
    1276           1 :     (while (setq temp (ange-ftp-real-file-symlink-p file))
    1277           0 :       (setq file
    1278           0 :             (if (file-name-absolute-p temp)
    1279           0 :                 temp
    1280             :               ;; Wouldn't `expand-file-name' be better than `concat' ?
    1281             :               ;; It would fail when `a/b/..' != `a', tho.  --Stef
    1282           1 :               (concat (file-name-directory file) temp)))))
    1283           1 :   file)
    1284             : 
    1285             : ;; Move along current line looking for the value of the TOKEN.
    1286             : ;; Valid separators between TOKEN and its value are commas and
    1287             : ;; whitespace.  Second arg LIMIT is a limit for the search.
    1288             : 
    1289             : (defun ange-ftp-parse-netrc-token (token limit)
    1290           0 :   (if (search-forward token limit t)
    1291           0 :       (let (beg)
    1292           0 :         (skip-chars-forward ", \t\r\n" limit)
    1293           0 :         (if (eq (following-char) ?\")      ;quoted token value
    1294           0 :             (progn (forward-char 1)
    1295           0 :                    (setq beg (point))
    1296           0 :                    (skip-chars-forward "^\"" limit)
    1297           0 :                    (forward-char 1)
    1298           0 :                    (buffer-substring beg (1- (point))))
    1299           0 :           (setq beg (point))
    1300           0 :           (skip-chars-forward "^, \t\r\n" limit)
    1301           0 :           (buffer-substring beg (point))))))
    1302             : 
    1303             : ;; Extract the values for the tokens `machine', `login',
    1304             : ;; `password' and `account' in the current buffer.  If successful,
    1305             : ;; record the information found.
    1306             : 
    1307             : (defun ange-ftp-parse-netrc-group ()
    1308           0 :   (let ((start (point))
    1309           0 :         (end (save-excursion
    1310           0 :                (if (looking-at "machine\\>")
    1311             :                    ;; Skip `machine' and the machine name that follows.
    1312           0 :                    (progn
    1313           0 :                      (skip-chars-forward "^ \t\r\n")
    1314           0 :                      (skip-chars-forward " \t\r\n")
    1315           0 :                      (skip-chars-forward "^ \t\r\n"))
    1316             :                  ;; Skip `default'.
    1317           0 :                  (skip-chars-forward "^ \t\r\n"))
    1318             :                ;; Find start of the next `machine' or `default'
    1319             :                ;; or the end of the buffer.
    1320           0 :                (if (re-search-forward "machine\\>\\|default\\>" nil t)
    1321           0 :                    (match-beginning 0)
    1322           0 :                  (point-max))))
    1323             :         machine login password account)
    1324           0 :     (setq machine  (ange-ftp-parse-netrc-token "machine"  end)
    1325           0 :           login    (ange-ftp-parse-netrc-token "login"    end)
    1326           0 :           password (ange-ftp-parse-netrc-token "password" end)
    1327           0 :           account  (ange-ftp-parse-netrc-token "account"  end))
    1328           0 :     (if (and machine login)
    1329             :         ;; found a `machine` token.
    1330           0 :         (progn
    1331           0 :           (ange-ftp-set-user machine login)
    1332           0 :           (ange-ftp-set-passwd machine login password)
    1333           0 :           (and account
    1334           0 :                (ange-ftp-set-account machine login account)))
    1335           0 :       (goto-char start)
    1336           0 :       (if (search-forward "default" end t)
    1337             :           ;; found a `default' token
    1338           0 :           (progn
    1339           0 :             (setq login    (ange-ftp-parse-netrc-token "login"    end)
    1340           0 :                   password (ange-ftp-parse-netrc-token "password" end)
    1341           0 :                   account  (ange-ftp-parse-netrc-token "account"  end))
    1342           0 :             (and login
    1343           0 :                  (setq ange-ftp-netrc-default-user login))
    1344           0 :             (and password
    1345           0 :                  (setq ange-ftp-netrc-default-password password))
    1346           0 :             (and account
    1347           0 :                  (setq ange-ftp-netrc-default-account account)))))
    1348           0 :     (goto-char end)))
    1349             : 
    1350             : ;; Read in ~/.netrc, if one exists.  If ~/.netrc file exists and has
    1351             : ;; the correct permissions then extract the machine, login,
    1352             : ;; password and account information from within.
    1353             : 
    1354             : (defun ange-ftp-parse-netrc ()
    1355             :   ;; We set this before actually doing it to avoid the possibility
    1356             :   ;; of an infinite loop if ange-ftp-netrc-filename is an FTP file.
    1357             :   (interactive)
    1358           1 :   (let (file attr)
    1359           1 :     (let ((default-directory "/"))
    1360           1 :       (setq file (ange-ftp-chase-symlinks
    1361           1 :                   (ange-ftp-real-expand-file-name ange-ftp-netrc-filename)))
    1362           1 :       (setq attr (ange-ftp-real-file-attributes file)))
    1363           1 :     (if (and attr                       ; file exists.
    1364           1 :              (not (equal (nth 5 attr) ange-ftp-netrc-modtime))) ; file changed
    1365           0 :         (save-match-data
    1366           0 :           (if (or ange-ftp-disable-netrc-security-check
    1367           0 :                   (and (eq (nth 2 attr) (user-uid)) ; Same uids.
    1368           0 :                        (string-match ".r..------" (nth 8 attr))))
    1369           0 :               (with-current-buffer
    1370             :                 ;; we are cheating a bit here.  I'm trying to do the equivalent
    1371             :                 ;; of find-file on the .netrc file, but then nuke it afterwards.
    1372             :                 ;; with the bit of logic below we should be able to have
    1373             :                 ;; encrypted .netrc files.
    1374           0 :                   (generate-new-buffer "*ftp-.netrc*")
    1375           0 :                 (ange-ftp-real-insert-file-contents file)
    1376           0 :                 (setq buffer-file-name file)
    1377           0 :                 (setq default-directory (file-name-directory file))
    1378           0 :                 (normal-mode t)
    1379           0 :                 (run-hooks 'find-file-hook)
    1380           0 :                 (setq buffer-file-name nil)
    1381           0 :                 (goto-char (point-min))
    1382           0 :                 (while (search-forward-regexp "^[ \t]*#.*$" nil t)
    1383           0 :                   (replace-match ""))
    1384           0 :                 (goto-char (point-min))
    1385           0 :                 (skip-chars-forward " \t\r\n")
    1386           0 :                 (while (not (eobp))
    1387           0 :                   (ange-ftp-parse-netrc-group))
    1388           0 :                 (kill-buffer (current-buffer)))
    1389           0 :             (ange-ftp-message "%s either not owned by you or badly protected."
    1390           0 :                               ange-ftp-netrc-filename)
    1391           0 :             (sit-for 1))
    1392           1 :           (setq ange-ftp-netrc-modtime (nth 5 attr))))))
    1393             : 
    1394             : ;; Return a list of prefixes of the form 'user@host:' to be used when
    1395             : ;; completion is done in the root directory.
    1396             : 
    1397             : (defun ange-ftp-generate-root-prefixes ()
    1398           0 :   (ange-ftp-parse-netrc)
    1399           0 :   (save-match-data
    1400           0 :     (let (res)
    1401           0 :       (maphash
    1402             :        (lambda (key value)
    1403           0 :          (if (string-match "\\`[^/]*\\(/\\).*\\'" key)
    1404           0 :              (let ((host (substring key 0 (match-beginning 1)))
    1405           0 :                    (user (substring key (match-end 1))))
    1406           0 :                (push (concat user "@" host ":") res))))
    1407           0 :        ange-ftp-passwd-hashtable)
    1408           0 :       (maphash
    1409           0 :        (lambda (host user) (push (concat host ":") res))
    1410           0 :        ange-ftp-user-hashtable)
    1411           0 :       (or res (list nil)))))
    1412             : 
    1413             : ;;;; ------------------------------------------------------------
    1414             : ;;;; Remote file name syntax support.
    1415             : ;;;; ------------------------------------------------------------
    1416             : 
    1417             : (defmacro ange-ftp-ftp-name-component (n ns name)
    1418             :   "Extract the Nth FTP file name component from NS."
    1419           3 :   `(let ((elt (nth ,n ,ns)))
    1420           3 :      (match-string elt ,name)))
    1421             : 
    1422             : (defvar ange-ftp-ftp-name-arg "")
    1423             : (defvar ange-ftp-ftp-name-res nil)
    1424             : 
    1425             : ;; Parse NAME according to `ange-ftp-name-format' (which see).
    1426             : ;; Returns a list (HOST USER NAME), or nil if NAME does not match the format.
    1427             : (defun ange-ftp-ftp-name (name)
    1428          13 :   (if (string-equal name ange-ftp-ftp-name-arg)
    1429           0 :       ange-ftp-ftp-name-res
    1430          13 :     (setq ange-ftp-ftp-name-arg name
    1431             :           ange-ftp-ftp-name-res
    1432          13 :           (save-match-data
    1433          13 :             (if (posix-string-match (car ange-ftp-name-format) name)
    1434           3 :                 (let* ((ns (cdr ange-ftp-name-format))
    1435           3 :                        (host (ange-ftp-ftp-name-component 0 ns name))
    1436           3 :                        (user (ange-ftp-ftp-name-component 1 ns name))
    1437           3 :                        (name (ange-ftp-ftp-name-component 2 ns name)))
    1438           3 :                   (if (zerop (length user))
    1439           3 :                       (setq user (ange-ftp-get-user host)))
    1440           3 :                   (list host user name))
    1441          13 :               nil)))))
    1442             : 
    1443             : ;; Take a FULLNAME that matches according to ange-ftp-name-format and
    1444             : ;; replace the name component with NAME.
    1445             : (defun ange-ftp-replace-name-component (fullname name)
    1446           0 :   (save-match-data
    1447           0 :     (if (posix-string-match (car ange-ftp-name-format) fullname)
    1448           0 :         (let* ((ns (cdr ange-ftp-name-format))
    1449           0 :                (elt (nth 2 ns)))
    1450           0 :           (concat (substring fullname 0 (match-beginning elt))
    1451           0 :                   name
    1452           0 :                   (substring fullname (match-end elt)))))))
    1453             : 
    1454             : ;;;; ------------------------------------------------------------
    1455             : ;;;; Miscellaneous utils.
    1456             : ;;;; ------------------------------------------------------------
    1457             : 
    1458             : ;; (setq ange-ftp-tmp-keymap (make-sparse-keymap))
    1459             : ;; (define-key ange-ftp-tmp-keymap "\C-m" 'exit-minibuffer)
    1460             : 
    1461             : (defun ange-ftp-repaint-minibuffer ()
    1462             :   "Clear any existing minibuffer message; let the minibuffer contents show."
    1463           0 :   (message nil))
    1464             : 
    1465             : ;; Return the name of the buffer that collects output from the ftp process
    1466             : ;; connected to the given HOST and USER pair.
    1467             : (defun ange-ftp-ftp-process-buffer (host user)
    1468           0 :   (concat "*ftp " user "@" host "*"))
    1469             : 
    1470             : ;; Display the last chunk of output from the ftp process for the given HOST
    1471             : ;; USER pair, and signal an error including MSG in the text.
    1472             : (defun ange-ftp-error (host user msg)
    1473           0 :   (save-excursion  ;; Prevent pop-to-buffer from changing current buffer.
    1474           0 :     (let ((cur (selected-window))
    1475             :           (pop-up-windows t))
    1476           0 :       (pop-to-buffer
    1477           0 :        (get-buffer-create
    1478           0 :         (ange-ftp-ftp-process-buffer host user)))
    1479           0 :       (goto-char (point-max))
    1480           0 :       (select-window cur))
    1481           0 :     (signal 'ftp-error (list (format "FTP Error: %s" msg)))))
    1482             : 
    1483             : (defun ange-ftp-set-buffer-mode ()
    1484             :   "Set correct modes for the current buffer if visiting a remote file."
    1485          10 :   (if (and (stringp buffer-file-name)
    1486          10 :            (ange-ftp-ftp-name buffer-file-name))
    1487          10 :       (auto-save-mode ange-ftp-auto-save)))
    1488             : 
    1489             : (defun ange-ftp-kill-ftp-process (&optional buffer)
    1490             :   "Kill the FTP process associated with BUFFER (the current buffer, if nil).
    1491             : If the BUFFER's visited filename or `default-directory' is an FTP filename
    1492             : then kill the related FTP process."
    1493             :   (interactive "bKill FTP process associated with buffer: ")
    1494           0 :   (if (null buffer)
    1495           0 :       (setq buffer (current-buffer))
    1496           0 :     (setq buffer (get-buffer buffer)))
    1497           0 :   (let ((file (or (buffer-file-name buffer)
    1498           0 :                   (with-current-buffer buffer default-directory))))
    1499           0 :     (if file
    1500           0 :         (let ((parsed (ange-ftp-ftp-name (expand-file-name file))))
    1501           0 :           (if parsed
    1502           0 :               (let ((host (nth 0 parsed))
    1503           0 :                     (user (nth 1 parsed)))
    1504           0 :                 (kill-buffer (get-buffer (ange-ftp-ftp-process-buffer host user)))))))))
    1505             : 
    1506             : (defun ange-ftp-quote-string (string)
    1507             :   "Quote any characters in STRING that may confuse the FTP process."
    1508             :   ;; This is said to be wrong; ftp is said to need quoting only for ",
    1509             :   ;; and that by doubling it.  But experiment says UNIX-style kind of
    1510             :   ;; quoting is correct when talking to ftp on GNU/Linux systems, and
    1511             :   ;; W32-style kind of quoting on, yes, W32 systems.
    1512           0 :   (if (stringp string)
    1513           0 :       (shell-quote-argument string)
    1514           0 :     ""))
    1515             : 
    1516             : (defun ange-ftp-barf-if-not-directory (directory)
    1517           0 :   (or (file-directory-p directory)
    1518           0 :       (let ((exists (file-exists-p directory)))
    1519           0 :         (signal (if exists 'file-error 'file-missing)
    1520           0 :                 (list "Opening directory"
    1521           0 :                       (if exists "Not a directory" "No such file or directory")
    1522           0 :                       directory)))))
    1523             : 
    1524             : ;;;; ------------------------------------------------------------
    1525             : ;;;; FTP process filter support.
    1526             : ;;;; ------------------------------------------------------------
    1527             : 
    1528             : (defun ange-ftp-process-handle-line (line proc)
    1529             :   "Look at the given LINE from the FTP process PROC.
    1530             : Try to categorize it into one of four categories:
    1531             : good, skip, fatal, or unknown."
    1532           0 :   (cond ((string-match ange-ftp-xfer-size-msgs line)
    1533           0 :          (setq ange-ftp-xfer-size
    1534           0 :                (/ (string-to-number (match-string 1 line))
    1535           0 :                   1024)))
    1536           0 :         ((string-match ange-ftp-skip-msgs line)
    1537             :          t)
    1538           0 :         ((string-match ange-ftp-good-msgs line)
    1539           0 :          (setq ange-ftp-process-busy nil
    1540             :                ange-ftp-process-result t
    1541             :                ange-ftp-pending-error-line nil
    1542           0 :                ange-ftp-process-result-line line))
    1543             :         ;; Check this before checking for errors.
    1544             :         ;; Otherwise the last line of these three seems to be an error:
    1545             :         ;; 230-see a significant impact from the move.  For those of you who can't
    1546             :         ;; 230-use DNS to resolve hostnames and get an error message like
    1547             :         ;; 230-"ftp.stsci.edu: unknown host", the new IP address will be...
    1548           0 :         ((string-match ange-ftp-multi-msgs line)
    1549           0 :          (setq ange-ftp-process-multi-skip t))
    1550           0 :         ((string-match ange-ftp-potential-error-msgs line)
    1551             :          ;; This looks like an error, but we have to keep reading the output
    1552             :          ;; to see if it was fixed or not.  E.g. it may indicate that IPv6
    1553             :          ;; failed, but maybe a subsequent IPv4 fallback succeeded.
    1554           0 :          (set (make-local-variable 'ange-ftp-pending-error-line) line)
    1555             :          t)
    1556           0 :         ((string-match ange-ftp-fatal-msgs line)
    1557           0 :          (delete-process proc)
    1558           0 :          (setq ange-ftp-process-busy nil
    1559           0 :                ange-ftp-process-result-line line))
    1560           0 :         (ange-ftp-process-multi-skip
    1561             :          t)
    1562             :         (t
    1563           0 :          (setq ange-ftp-process-busy nil
    1564           0 :                ange-ftp-process-result-line line))))
    1565             : 
    1566             : (defun ange-ftp-set-xfer-size (host user bytes)
    1567             :   "Set the size of the next FTP transfer in bytes."
    1568           0 :   (let ((proc (ange-ftp-get-process host user)))
    1569           0 :     (when proc
    1570           0 :       (let ((buf (process-buffer proc)))
    1571           0 :         (when buf
    1572           0 :           (with-current-buffer buf
    1573           0 :             (setq ange-ftp-xfer-size
    1574             :                   ;; For very large files, BYTES can be a float.
    1575           0 :                   (if (integerp bytes)
    1576           0 :                       (ash bytes -10)
    1577           0 :                     (/ bytes 1024)))))))))
    1578             : 
    1579             : (defun ange-ftp-process-handle-hash (string)
    1580             :   "Remove hash marks from STRING and display count so far."
    1581           0 :   (setq string (concat (substring string 0 (match-beginning 0))
    1582           0 :                        (substring string (match-end 0)))
    1583           0 :         ange-ftp-hash-mark-count (+ (- (match-end 0)
    1584           0 :                                        (match-beginning 0))
    1585           0 :                                     ange-ftp-hash-mark-count))
    1586           0 :   (and ange-ftp-hash-mark-unit
    1587           0 :        ange-ftp-process-msg
    1588           0 :        ange-ftp-process-verbose
    1589           0 :        (not (eq (selected-window) (minibuffer-window)))
    1590           0 :        (not (boundp 'search-message))   ;screws up isearch otherwise
    1591           0 :        (not cursor-in-echo-area)        ;screws up y-or-n-p otherwise
    1592           0 :        (let ((kbytes (ash (* ange-ftp-hash-mark-unit
    1593           0 :                              ange-ftp-hash-mark-count)
    1594           0 :                           -6)))
    1595           0 :          (if (zerop ange-ftp-xfer-size)
    1596           0 :              (ange-ftp-message "%s...%dk" ange-ftp-process-msg kbytes)
    1597           0 :            (let ((percent (floor (* 100.0 kbytes) ange-ftp-xfer-size)))
    1598             :              ;; cut out the redisplay of identical %-age messages.
    1599           0 :              (unless (eq percent ange-ftp-last-percent)
    1600           0 :                (setq ange-ftp-last-percent percent)
    1601           0 :                (ange-ftp-message "%s...%d%%" ange-ftp-process-msg percent))))))
    1602           0 :   string)
    1603             : 
    1604             : ;; Call the function specified by CONT.  CONT can be either a function
    1605             : ;; or a list of a function and some args.  The first two parameters
    1606             : ;; passed to the function will be RESULT and LINE.  The remaining args
    1607             : ;; will be taken from CONT if a list was passed.
    1608             : 
    1609             : (defun ange-ftp-call-cont (cont result line)
    1610           0 :   (when cont
    1611           0 :     (if (and (listp cont)
    1612           0 :              (not (eq (car cont) 'lambda)))
    1613           0 :         (apply (car cont) result line (cdr cont))
    1614           0 :       (funcall cont result line))))
    1615             : 
    1616             : ;; Build up a complete line of output from the ftp PROCESS and pass it
    1617             : ;; on to ange-ftp-process-handle-line to deal with.
    1618             : 
    1619             : (defun ange-ftp-process-filter (proc str)
    1620             :   ;; Eliminate nulls.
    1621           0 :   (while (string-match "\000+" str)
    1622           0 :     (setq str (replace-match "" nil nil str)))
    1623             : 
    1624             :   ;; see if the buffer is still around... it could have been deleted.
    1625           0 :   (when (buffer-live-p (process-buffer proc))
    1626           0 :     (with-current-buffer (process-buffer proc)
    1627             : 
    1628             :       ;; handle hash mark printing
    1629           0 :       (and ange-ftp-process-busy
    1630           0 :            (string-match "^#+$" str)
    1631           0 :            (setq str (ange-ftp-process-handle-hash str)))
    1632           0 :       (comint-output-filter proc str)
    1633             :       ;; Replace STR by the result of the comint processing.
    1634           0 :       (setq str (buffer-substring comint-last-output-start
    1635           0 :                                   (process-mark proc)))
    1636           0 :       (when ange-ftp-process-busy
    1637           0 :         (setq ange-ftp-process-string (concat ange-ftp-process-string
    1638           0 :                                               str))
    1639             : 
    1640             :         ;; if we gave an empty password to the USER command earlier
    1641             :         ;; then we should send a null password now.
    1642           0 :         (if (string-match "Password: *$" ange-ftp-process-string)
    1643           0 :             (process-send-string proc "\n")))
    1644           0 :       (while (and ange-ftp-process-busy
    1645           0 :                   (string-match "\n" ange-ftp-process-string))
    1646           0 :         (let ((line (substring ange-ftp-process-string
    1647             :                                0
    1648           0 :                                (match-beginning 0)))
    1649             :               (seen-prompt nil))
    1650           0 :           (setq ange-ftp-process-string (substring ange-ftp-process-string
    1651           0 :                                                    (match-end 0)))
    1652           0 :           (while (string-match "\\`ftp> *" line)
    1653           0 :             (setq seen-prompt t)
    1654           0 :             (setq line (substring line (match-end 0))))
    1655           0 :           (if (not (and seen-prompt ange-ftp-pending-error-line))
    1656           0 :               (ange-ftp-process-handle-line line proc)
    1657             :             ;; If we've seen a potential error message and it
    1658             :             ;; hasn't been canceled by a good message before
    1659             :             ;; seeing a prompt, then the error was real.
    1660           0 :             (delete-process proc)
    1661           0 :             (setq ange-ftp-process-busy nil
    1662           0 :                   ange-ftp-process-result-line ange-ftp-pending-error-line))))
    1663             : 
    1664             :       ;; has the ftp client finished?  if so then do some clean-up
    1665             :       ;; actions.
    1666           0 :       (unless ange-ftp-process-busy
    1667             :         ;; reset the xfer size
    1668           0 :         (setq ange-ftp-xfer-size 0)
    1669             : 
    1670             :         ;; issue the "done" message since we've finished.
    1671           0 :         (when (and ange-ftp-process-msg
    1672           0 :                    ange-ftp-process-verbose
    1673           0 :                    ange-ftp-process-result)
    1674           0 :           (ange-ftp-message "%s...done" ange-ftp-process-msg)
    1675           0 :           (ange-ftp-repaint-minibuffer)
    1676           0 :           (setq ange-ftp-process-msg nil))
    1677             : 
    1678             :         ;; is there a continuation we should be calling?  if so,
    1679             :         ;; we'd better call it, making sure we only call it once.
    1680           0 :         (when ange-ftp-process-continue
    1681           0 :           (let ((cont ange-ftp-process-continue))
    1682           0 :             (setq ange-ftp-process-continue nil)
    1683           0 :             (ange-ftp-call-cont cont
    1684           0 :                                 ange-ftp-process-result
    1685           0 :                                 ange-ftp-process-result-line)))))))
    1686             : 
    1687             : (defun ange-ftp-process-sentinel (proc str)
    1688             :   "When FTP process changes state, nuke all file-entries in cache."
    1689           0 :   (let ((name (process-name proc)))
    1690           0 :     (when (string-match "\\*ftp \\([^@]+\\)@\\([^*]+\\)\\*" name)
    1691           0 :       (let ((user (match-string 1 name))
    1692           0 :             (host (match-string 2 name)))
    1693           0 :         (ange-ftp-wipe-file-entries host user))))
    1694           0 :   (setq ange-ftp-ls-cache-file nil))
    1695             : 
    1696             : ;;;; ------------------------------------------------------------
    1697             : ;;;; Gateway support.
    1698             : ;;;; ------------------------------------------------------------
    1699             : 
    1700             : (defun ange-ftp-use-gateway-p (host)
    1701             :   "Return whether to access this HOST via a normal (non-smart) gateway."
    1702             :   ;; yes, I know that I could simplify the following expression, but it is
    1703             :   ;; clearer (to me at least) this way.
    1704           0 :   (and (not ange-ftp-smart-gateway)
    1705           0 :        (not (string-match-p ange-ftp-local-host-regexp host))))
    1706             : 
    1707             : (defun ange-ftp-use-smart-gateway-p (host)
    1708             :   "Returns whether to access this HOST via a smart gateway."
    1709           0 :   (and ange-ftp-smart-gateway
    1710           0 :        (not (string-match-p ange-ftp-local-host-regexp host))))
    1711             : 
    1712             : 
    1713             : ;;; ------------------------------------------------------------
    1714             : ;;; Temporary file location and deletion...
    1715             : ;;; ------------------------------------------------------------
    1716             : 
    1717             : (defun ange-ftp-make-tmp-name (host &optional suffix)
    1718             :   "This routine will return the name of a new file."
    1719           0 :   (make-temp-file (if (ange-ftp-use-gateway-p host)
    1720           0 :                       ange-ftp-gateway-tmp-name-template
    1721           0 :                     ange-ftp-tmp-name-template)
    1722           0 :                   nil suffix))
    1723             : 
    1724             : (defun ange-ftp-del-tmp-name (filename)
    1725             :   "Force to delete temporary file."
    1726           0 :   (delete-file filename))
    1727             : 
    1728             : 
    1729             : ;;;; ------------------------------------------------------------
    1730             : ;;;; Interactive gateway program support.
    1731             : ;;;; ------------------------------------------------------------
    1732             : 
    1733             : (defvar ange-ftp-gwp-running t)
    1734             : (defvar ange-ftp-gwp-status nil)
    1735             : 
    1736             : (defun ange-ftp-gwp-sentinel (proc str)
    1737           0 :   (setq ange-ftp-gwp-running nil))
    1738             : 
    1739             : (defun ange-ftp-gwp-filter (proc str)
    1740           0 :   (comint-output-filter proc str)
    1741           0 :   (with-current-buffer (process-buffer proc)
    1742             :     ;; Replace STR by the result of the comint processing.
    1743           0 :     (setq str (buffer-substring comint-last-output-start (process-mark proc))))
    1744           0 :   (cond ((string-match "login: *$" str)
    1745           0 :          (process-send-string proc
    1746           0 :                               (concat
    1747           0 :                                (let ((ange-ftp-default-user t))
    1748           0 :                                  (ange-ftp-get-user ange-ftp-gateway-host))
    1749           0 :                                "\n")))
    1750           0 :         ((string-match "Password: *$" str)
    1751           0 :          (process-send-string proc
    1752           0 :                               (concat
    1753           0 :                                (ange-ftp-get-passwd ange-ftp-gateway-host
    1754           0 :                                                     (ange-ftp-get-user
    1755           0 :                                                      ange-ftp-gateway-host))
    1756           0 :                                "\n")))
    1757           0 :         ((string-match ange-ftp-gateway-fatal-msgs str)
    1758           0 :          (delete-process proc)
    1759           0 :          (setq ange-ftp-gwp-running nil))
    1760           0 :         ((string-match ange-ftp-gateway-prompt-pattern str)
    1761           0 :          (setq ange-ftp-gwp-running nil
    1762           0 :                ange-ftp-gwp-status t))))
    1763             : 
    1764             : (defun ange-ftp-gwp-start (host user name args)
    1765             :   "Login to the gateway machine and fire up an FTP process."
    1766             :   ;; If `non-essential' is non-nil, don't reopen a new connection.  It
    1767             :   ;; will be caught in Tramp.
    1768           0 :   (when non-essential
    1769           0 :     (throw 'non-essential 'non-essential))
    1770           0 :   (let (;; It would be nice to make process-connection-type nil,
    1771             :         ;; but that doesn't work: ftp never responds.
    1772             :         ;; Can anyone find a fix for that?
    1773           0 :         (proc (let ((process-connection-type t))
    1774           0 :                 (start-process name name
    1775           0 :                                ange-ftp-gateway-program
    1776           0 :                                ange-ftp-gateway-host)))
    1777           0 :         (ftp (mapconcat 'identity args " ")))
    1778           0 :     (set-process-query-on-exit-flag proc nil)
    1779           0 :     (set-process-sentinel proc 'ange-ftp-gwp-sentinel)
    1780           0 :     (set-process-filter proc 'ange-ftp-gwp-filter)
    1781           0 :     (with-current-buffer (process-buffer proc)
    1782           0 :       (goto-char (point-max))
    1783           0 :       (set-marker (process-mark proc) (point)))
    1784           0 :     (setq ange-ftp-gwp-running t
    1785           0 :           ange-ftp-gwp-status nil)
    1786           0 :     (ange-ftp-message "Connecting to gateway %s..." ange-ftp-gateway-host)
    1787           0 :     (while ange-ftp-gwp-running         ;perform login sequence
    1788           0 :       (accept-process-output proc))
    1789           0 :     (unless ange-ftp-gwp-status
    1790           0 :       (ange-ftp-error host user "unable to login to gateway"))
    1791           0 :     (ange-ftp-message "Connecting to gateway %s...done" ange-ftp-gateway-host)
    1792           0 :     (setq ange-ftp-gwp-running t
    1793           0 :           ange-ftp-gwp-status nil)
    1794           0 :     (process-send-string proc ange-ftp-gateway-setup-term-command)
    1795           0 :     (while ange-ftp-gwp-running         ;zap ^M's and double echoing.
    1796           0 :       (accept-process-output proc))
    1797           0 :     (unless ange-ftp-gwp-status
    1798           0 :       (ange-ftp-error host user "unable to set terminal modes on gateway"))
    1799           0 :     (setq ange-ftp-gwp-running t
    1800           0 :           ange-ftp-gwp-status nil)
    1801           0 :     (process-send-string proc (concat "exec " ftp "\n")) ;spawn ftp process
    1802           0 :     proc))
    1803             : 
    1804             : ;;;; ------------------------------------------------------------
    1805             : ;;;; Support for sending commands to the ftp process.
    1806             : ;;;; ------------------------------------------------------------
    1807             : 
    1808             : (defun ange-ftp-raw-send-cmd (proc cmd &optional msg cont nowait)
    1809             :   "Low-level routine to send the given FTP CMD to the FTP process PROC.
    1810             : MSG is an optional message to output before and after the command.
    1811             : If CONT is non-nil then it is either a function or a list of function
    1812             : and some arguments.  The function will be called when the FTP command
    1813             : has completed.
    1814             : If CONT is nil then this routine will return (RESULT . LINE) where RESULT
    1815             : is whether the command was successful, and LINE is the line from the FTP
    1816             : process that caused the command to complete.
    1817             : If NOWAIT is given then the routine will return immediately the command has
    1818             : been queued with no result.  CONT will still be called, however."
    1819           0 :   (if (memq (process-status proc) '(run open))
    1820           0 :       (with-current-buffer (process-buffer proc)
    1821           0 :         (ange-ftp-wait-not-busy proc)
    1822           0 :         (setq ange-ftp-process-string ""
    1823             :               ange-ftp-process-result-line ""
    1824             :               ange-ftp-process-busy t
    1825             :               ange-ftp-process-result nil
    1826             :               ange-ftp-process-multi-skip nil
    1827           0 :               ange-ftp-process-msg msg
    1828           0 :               ange-ftp-process-continue cont
    1829             :               ange-ftp-hash-mark-count 0
    1830             :               ange-ftp-last-percent -1
    1831           0 :               cmd (concat cmd "\n"))
    1832           0 :         (and msg ange-ftp-process-verbose (ange-ftp-message "%s..." msg))
    1833           0 :         (goto-char (point-max))
    1834           0 :         (move-marker comint-last-input-start (point))
    1835             :         ;; don't insert the password into the buffer on the USER command.
    1836           0 :         (save-match-data
    1837           0 :           (if (string-match "\\`user \"[^\"]*\"" cmd)
    1838           0 :               (insert (substring cmd 0 (match-end 0)) " Turtle Power!\n")
    1839           0 :             (insert cmd)))
    1840           0 :         (move-marker comint-last-input-end (point))
    1841           0 :         (process-send-string proc cmd)
    1842           0 :         (set-marker (process-mark proc) (point))
    1843           0 :         (if nowait
    1844             :             nil
    1845           0 :           (ange-ftp-wait-not-busy proc)
    1846           0 :           (if cont
    1847             :               nil                       ;cont has already been called
    1848           0 :             (cons ange-ftp-process-result ange-ftp-process-result-line))))))
    1849             : 
    1850             : ;; Wait for the ange-ftp process PROC not to be busy.
    1851             : (defun ange-ftp-wait-not-busy (proc)
    1852           0 :   (with-current-buffer (process-buffer proc)
    1853           0 :     (condition-case nil
    1854             :         ;; This is a kludge to let user quit in case ftp gets hung.
    1855             :         ;; It matters because this function can be called from the filter.
    1856             :         ;; It is bad to allow quitting in a filter, but getting hung
    1857             :         ;; is worse.  By binding quit-flag to nil, we might avoid
    1858             :         ;; most of the probability of getting screwed because the user
    1859             :         ;; wants to quit some command.
    1860           0 :         (let ((quit-flag nil)
    1861             :               (inhibit-quit nil))
    1862           0 :           (while ange-ftp-process-busy
    1863           0 :             (accept-process-output proc)))
    1864             :       (quit
    1865             :        ;; If the user does quit out of this,
    1866             :        ;; kill the process.  That stops any transfer in progress.
    1867             :        ;; The next operation will open a new ftp connection.
    1868           0 :        (delete-process proc)
    1869           0 :        (signal 'quit nil)))))
    1870             : 
    1871             : (defun ange-ftp-nslookup-host (hostname)
    1872             :   "Attempt to resolve the given HOSTNAME using nslookup if possible."
    1873             :   (interactive "sHost:  ")
    1874           0 :   (if ange-ftp-nslookup-program
    1875           0 :       (let ((default-directory
    1876           0 :               (if (file-accessible-directory-p default-directory)
    1877           0 :                   default-directory
    1878           0 :                 exec-directory))
    1879             :             ;; It would be nice to make process-connection-type nil,
    1880             :             ;; but that doesn't work: ftp never responds.
    1881             :             ;; Can anyone find a fix for that?
    1882           0 :             (proc (let ((process-connection-type t))
    1883           0 :                     (start-process " *nslookup*" " *nslookup*"
    1884           0 :                                    ange-ftp-nslookup-program hostname)))
    1885           0 :             (res hostname))
    1886           0 :         (set-process-query-on-exit-flag proc nil)
    1887           0 :         (with-current-buffer (process-buffer proc)
    1888           0 :           (while (memq (process-status proc) '(run open))
    1889           0 :             (accept-process-output proc))
    1890           0 :           (goto-char (point-min))
    1891           0 :           (if (re-search-forward "Name:.*\nAddress: *\\(.*\\)$" nil t)
    1892           0 :               (setq res (match-string 1)))
    1893           0 :           (kill-buffer (current-buffer)))
    1894           0 :         res)
    1895           0 :     hostname))
    1896             : 
    1897             : (defun ange-ftp-start-process (host user name)
    1898             :   "Spawn a new FTP process ready to connect to machine HOST and give it NAME.
    1899             : If HOST is only FTP-able through a gateway machine then spawn a shell
    1900             : on the gateway machine to do the FTP instead."
    1901             :   ;; If `non-essential' is non-nil, don't reopen a new connection.  It
    1902             :   ;; will be caught in Tramp.
    1903           0 :   (when non-essential
    1904           0 :     (throw 'non-essential 'non-essential))
    1905           0 :   (let* ((use-gateway (ange-ftp-use-gateway-p host))
    1906           0 :          (use-smart-ftp (and (not ange-ftp-gateway-host)
    1907           0 :                              (ange-ftp-use-smart-gateway-p host)))
    1908           0 :          (ftp-prog (if (or use-gateway
    1909           0 :                            use-smart-ftp)
    1910           0 :                        ange-ftp-gateway-ftp-program-name
    1911           0 :                      ange-ftp-ftp-program-name))
    1912           0 :          (args (append (list ftp-prog) ange-ftp-ftp-program-args))
    1913             :          ;; Without the following binding, ange-ftp-start-process
    1914             :          ;; recurses on file-accessible-directory-p, since it needs to
    1915             :          ;; restart its process in order to determine anything about
    1916             :          ;; default-directory.
    1917             :          (file-name-handler-alist)
    1918             :          (default-directory
    1919           0 :            (if (file-accessible-directory-p default-directory)
    1920           0 :                default-directory
    1921           0 :              exec-directory))
    1922             :          proc)
    1923             :     ;; It would be nice to make process-connection-type nil,
    1924             :     ;; but that doesn't work: ftp never responds.
    1925             :     ;; Can anyone find a fix for that?
    1926           0 :     (let ((process-connection-type t)
    1927             :           ;; Copy this so we don't alter it permanently.
    1928           0 :           (process-environment (copy-tree process-environment))
    1929           0 :           (buffer (get-buffer-create name)))
    1930           0 :       (with-current-buffer buffer
    1931           0 :         (internal-ange-ftp-mode))
    1932             :       ;; This tells GNU ftp not to output any fancy escape sequences.
    1933           0 :       (setenv "TERM" "dumb")
    1934           0 :       (if use-gateway
    1935           0 :           (if ange-ftp-gateway-program-interactive
    1936           0 :               (setq proc (ange-ftp-gwp-start host user name args))
    1937           0 :             (setq proc (apply 'start-process name name
    1938           0 :                               (append (list ange-ftp-gateway-program
    1939           0 :                                             ange-ftp-gateway-host)
    1940           0 :                                       args))))
    1941           0 :         (setq proc (apply 'start-process name name args))))
    1942           0 :     (with-current-buffer (process-buffer proc)
    1943           0 :       (goto-char (point-max))
    1944           0 :       (set-marker (process-mark proc) (point)))
    1945           0 :     (set-process-query-on-exit-flag proc nil)
    1946           0 :     (set-process-sentinel proc 'ange-ftp-process-sentinel)
    1947           0 :     (set-process-filter proc 'ange-ftp-process-filter)
    1948             :     ;; On Windows, the standard ftp client buffers its output (because
    1949             :     ;; stdout is a pipe handle) so the startup message may never appear:
    1950             :     ;; `accept-process-output' at this point would hang indefinitely.
    1951             :     ;; However, sending an innocuous command ("help foo") forces some
    1952             :     ;; output that will be ignored, which is just as good.  Once we
    1953             :     ;; start sending normal commands, the output no longer appears to be
    1954             :     ;; buffered, and everything works correctly.  My guess is that the
    1955             :     ;; output of interest is being sent to stderr which is not buffered.
    1956           0 :     (when (eq system-type 'windows-nt)
    1957             :       ;; force ftp output to be treated as DOS text, otherwise the
    1958             :       ;; output of "help foo" confuses the EOL detection logic.
    1959           0 :       (set-process-coding-system proc 'raw-text-dos)
    1960           0 :       (process-send-string proc "help foo\n"))
    1961           0 :     (accept-process-output proc)        ;wait for ftp startup message
    1962           0 :     proc))
    1963             : 
    1964             : (define-derived-mode internal-ange-ftp-mode comint-mode "Internal Ange-ftp"
    1965             :   "Major mode for interacting with the FTP process.
    1966             : 
    1967             : \\{comint-mode-map}"
    1968           0 :   (make-local-variable 'ange-ftp-process-string)
    1969           0 :   (setq ange-ftp-process-string "")
    1970           0 :   (make-local-variable 'ange-ftp-process-busy)
    1971           0 :   (make-local-variable 'ange-ftp-process-result)
    1972           0 :   (make-local-variable 'ange-ftp-process-msg)
    1973           0 :   (make-local-variable 'ange-ftp-process-multi-skip)
    1974           0 :   (make-local-variable 'ange-ftp-process-result-line)
    1975           0 :   (make-local-variable 'ange-ftp-process-continue)
    1976           0 :   (make-local-variable 'ange-ftp-hash-mark-count)
    1977           0 :   (make-local-variable 'ange-ftp-binary-hash-mark-size)
    1978           0 :   (make-local-variable 'ange-ftp-ascii-hash-mark-size)
    1979           0 :   (make-local-variable 'ange-ftp-hash-mark-unit)
    1980           0 :   (make-local-variable 'ange-ftp-xfer-size)
    1981           0 :   (make-local-variable 'ange-ftp-last-percent)
    1982           0 :   (setq ange-ftp-hash-mark-count 0)
    1983           0 :   (setq ange-ftp-xfer-size 0)
    1984           0 :   (setq ange-ftp-process-result-line "")
    1985           0 :   (setq comint-prompt-regexp "^ftp> ")
    1986           0 :   (make-local-variable 'comint-password-prompt-regexp)
    1987             :   ;; This is a regexp that can't match anything.
    1988             :   ;; ange-ftp has its own ways of handling passwords.
    1989           0 :   (setq comint-password-prompt-regexp "\\`a\\`")
    1990           0 :   (make-local-variable 'paragraph-start)
    1991           0 :   (setq paragraph-start comint-prompt-regexp))
    1992             : 
    1993             : (defcustom ange-ftp-raw-login nil
    1994             :   "Use raw FTP commands for login, if account password is not nil.
    1995             : Some FTP implementations need this, e.g. ftp in NT 4.0."
    1996             :   :group 'ange-ftp
    1997             :   :version "21.3"
    1998             :   :type 'boolean)
    1999             : 
    2000             : (defun ange-ftp-smart-login (host user password account proc)
    2001             :   "Connect to the FTP-server on HOST as USER using PASSWORD and ACCOUNT.
    2002             : PROC is the FTP-client's process.  This routine uses the smart-gateway
    2003             : host specified in `ange-ftp-gateway-host'."
    2004           0 :   (let ((result (ange-ftp-raw-send-cmd
    2005           0 :                  proc
    2006           0 :                  (format "open %s %s"
    2007           0 :                          (ange-ftp-nslookup-host ange-ftp-gateway-host)
    2008           0 :                          ange-ftp-smart-gateway-port)
    2009           0 :                  (format "Opening FTP connection to %s via %s"
    2010           0 :                          host
    2011           0 :                          ange-ftp-gateway-host))))
    2012           0 :     (or (car result)
    2013           0 :         (ange-ftp-error host user
    2014           0 :                         (concat "OPEN request failed: "
    2015           0 :                                 (cdr result))))
    2016           0 :     (setq result (ange-ftp-raw-send-cmd
    2017           0 :                   proc (format "user \"%s\"@%s %s %s"
    2018           0 :                                user
    2019           0 :                                (ange-ftp-nslookup-host host)
    2020           0 :                                password
    2021           0 :                                account)
    2022           0 :                   (format "Logging in as user %s@%s"
    2023           0 :                           user host)))
    2024           0 :     (or (car result)
    2025           0 :         (progn
    2026           0 :           (ange-ftp-set-passwd host user nil) ; reset password
    2027           0 :           (ange-ftp-set-account host user nil) ; reset account
    2028           0 :           (ange-ftp-error host user
    2029           0 :                           (concat "USER request failed: "
    2030           0 :                                   (cdr result)))))))
    2031             : 
    2032             : (defun ange-ftp-normal-login (host user password account proc)
    2033             :   "Connect to the FTP-server on HOST as USER using PASSWORD and ACCOUNT.
    2034             : PROC is the process to the FTP-client.  HOST may have an optional
    2035             : suffix of the form #PORT to specify a non-default port."
    2036           0 :   (save-match-data
    2037           0 :     (string-match "\\`\\([^#]+\\)\\(#\\([0-9]+\\)\\)?\\'" host)
    2038           0 :     (let* ((nshost (ange-ftp-nslookup-host (match-string 1 host)))
    2039           0 :            (port (match-string 3 host))
    2040           0 :            (result (ange-ftp-raw-send-cmd
    2041           0 :                     proc
    2042           0 :                     (if port
    2043           0 :                         (format "open %s %s" nshost port)
    2044           0 :                       (format "open %s" nshost))
    2045           0 :                     (format "Opening FTP connection to %s" host))))
    2046           0 :       (or (car result)
    2047           0 :           (ange-ftp-error host user
    2048           0 :                           (concat "OPEN request failed: "
    2049           0 :                                   (cdr result))))
    2050           0 :       (if (not (and ange-ftp-raw-login (string< "" account)))
    2051           0 :           (setq result (ange-ftp-raw-send-cmd
    2052           0 :                         proc
    2053           0 :                         (if (and (ange-ftp-use-smart-gateway-p host)
    2054           0 :                                  ange-ftp-gateway-host)
    2055           0 :                             (format "user \"%s\"@%s %s %s"
    2056           0 :                                     user nshost password account)
    2057           0 :                           (format "user \"%s\" %s %s" user password account))
    2058           0 :                         (format "Logging in as user %s@%s" user host)))
    2059           0 :         (let ((good ange-ftp-good-msgs)
    2060           0 :               (skip ange-ftp-skip-msgs))
    2061           0 :           (setq ange-ftp-good-msgs (concat ange-ftp-good-msgs
    2062           0 :                                            "\\|^331 \\|^332 "))
    2063           0 :           (if (string-match (regexp-quote "\\|^331 ") ange-ftp-skip-msgs)
    2064           0 :               (setq ange-ftp-skip-msgs
    2065           0 :                     (replace-match "" t t ange-ftp-skip-msgs)))
    2066           0 :           (if (string-match (regexp-quote "\\|^332 ") ange-ftp-skip-msgs)
    2067           0 :               (setq ange-ftp-skip-msgs
    2068           0 :                     (replace-match "" t t ange-ftp-skip-msgs)))
    2069           0 :           (setq result (ange-ftp-raw-send-cmd
    2070           0 :                         proc
    2071           0 :                         (format "quote \"USER %s\"" user)
    2072           0 :                         (format "Logging in as user %s@%s" user host)))
    2073           0 :           (and (car result)
    2074           0 :                (setq result (ange-ftp-raw-send-cmd
    2075           0 :                              proc
    2076           0 :                              (format "quote \"PASS %s\"" password)
    2077           0 :                              (format "Logging in as user %s@%s" user host)))
    2078           0 :                (and (car result)
    2079           0 :                     (setq result (ange-ftp-raw-send-cmd
    2080           0 :                                   proc
    2081           0 :                                   (format "quote \"ACCT %s\"" account)
    2082           0 :                                   (format "Logging in as user %s@%s" user host)))
    2083           0 :                     ))
    2084           0 :           (setq ange-ftp-good-msgs good
    2085           0 :                 ange-ftp-skip-msgs skip)))
    2086           0 :       (or (car result)
    2087           0 :           (progn
    2088           0 :             (ange-ftp-set-passwd host user nil) ;reset password.
    2089           0 :             (ange-ftp-set-account host user nil) ;reset account.
    2090           0 :             (ange-ftp-error host user
    2091           0 :                             (concat "USER request failed: "
    2092           0 :                                     (cdr result))))))))
    2093             : 
    2094             : ;; ange@hplb.hpl.hp.com says this should not be changed.
    2095             : (defvar ange-ftp-hash-mark-msgs
    2096             :   "[hH]ash mark [^0-9]*\\([0-9]+\\)"
    2097             :   "Regexp matching the FTP client's output upon doing a HASH command.")
    2098             : 
    2099             : (defun ange-ftp-guess-hash-mark-size (proc)
    2100           0 :   (if ange-ftp-send-hash
    2101           0 :       (with-current-buffer (process-buffer proc)
    2102           0 :         (let* ((status (ange-ftp-raw-send-cmd proc "hash"))
    2103           0 :                (line (cdr status)))
    2104           0 :           (save-match-data
    2105           0 :             (if (string-match ange-ftp-hash-mark-msgs line)
    2106           0 :                 (let ((size (string-to-number (match-string 1 line))))
    2107           0 :                   (setq ange-ftp-ascii-hash-mark-size size
    2108           0 :                         ange-ftp-hash-mark-unit (ash size -4))
    2109             : 
    2110             :                   ;; if a default value for this is set, use that value.
    2111           0 :                   (or ange-ftp-binary-hash-mark-size
    2112           0 :                       (setq ange-ftp-binary-hash-mark-size size)))))))))
    2113             : 
    2114             : (defvar ange-ftp-process-startup-hook nil)
    2115             : 
    2116             : (defun ange-ftp-get-process (host user)
    2117             :   "Return an FTP subprocess connected to HOST and logged in as USER.
    2118             : Create a new process if needed."
    2119           0 :   (let* ((name (ange-ftp-ftp-process-buffer host user))
    2120           0 :          (proc (get-process name)))
    2121           0 :     (if (and proc (memq (process-status proc) '(run open)))
    2122           0 :         proc
    2123             :       ;; If `non-essential' is non-nil, don't reopen a new connection.  It
    2124             :       ;; will be caught in Tramp.
    2125           0 :       (when non-essential
    2126           0 :         (throw 'non-essential 'non-essential))
    2127             : 
    2128             :       ;; Must delete dead process so that new process can reuse the name.
    2129           0 :       (if proc (delete-process proc))
    2130           0 :       (let ((pass (ange-ftp-quote-string
    2131           0 :                    (ange-ftp-get-passwd host user)))
    2132           0 :             (account (ange-ftp-quote-string
    2133           0 :                       (ange-ftp-get-account host user))))
    2134             :         ;; grab a suitable process.
    2135           0 :         (setq proc (ange-ftp-start-process host user name))
    2136             : 
    2137             :         ;; login to FTP server.
    2138           0 :         (if (and (ange-ftp-use-smart-gateway-p host)
    2139           0 :                  ange-ftp-gateway-host)
    2140           0 :             (ange-ftp-smart-login host user pass account proc)
    2141           0 :           (ange-ftp-normal-login host user pass account proc))
    2142             : 
    2143             :         ;; Tell client to send back hash-marks as progress.  It isn't usually
    2144             :         ;; fatal if this command fails.
    2145           0 :         (ange-ftp-guess-hash-mark-size proc)
    2146             : 
    2147             :         ;; Guess at the host type.
    2148           0 :         (ange-ftp-guess-host-type host user)
    2149             : 
    2150             :         ;; Turn passive mode on or off as requested.
    2151           0 :         (let* ((case-fold-search t)
    2152             :                (passive
    2153           0 :                 (or (assoc-default host ange-ftp-passive-host-alist
    2154           0 :                                    'string-match)
    2155           0 :                     (if ange-ftp-try-passive-mode "on"))))
    2156           0 :           (if passive
    2157           0 :               (ange-ftp-passive-mode proc passive)))
    2158             : 
    2159             :         ;; Run any user-specified hooks.  Note that proc, host and user are
    2160             :         ;; dynamically bound at this point.
    2161           0 :         (let ((ange-ftp-this-user user)
    2162           0 :               (ange-ftp-this-host host))
    2163           0 :           (run-hooks 'ange-ftp-process-startup-hook)))
    2164           0 :       proc)))
    2165             : 
    2166             : (defun ange-ftp-passive-mode (proc on-or-off)
    2167           0 :   (if (string-match (concat "Passive mode " on-or-off)
    2168           0 :                     (cdr (ange-ftp-raw-send-cmd
    2169           0 :                           proc (concat "passive " on-or-off)
    2170           0 :                           "Trying passive mode..." nil)))
    2171           0 :       (ange-ftp-message (concat "Trying passive mode..." on-or-off))
    2172           0 :     (error "Trying passive mode...failed")))
    2173             : 
    2174             : ;; Variables for caching host and host-type
    2175             : (defvar ange-ftp-host-cache nil)
    2176             : (defvar ange-ftp-host-type-cache nil)
    2177             : 
    2178             : ;; If ange-ftp-host-type is called with the optional user
    2179             : ;; argument, it will attempt to guess the host type by connecting
    2180             : ;; as user, if necessary. For efficiency, I have tried to give this
    2181             : ;; optional second argument only when necessary. Have I missed any calls
    2182             : ;; to ange-ftp-host-type where it should have been supplied?
    2183             : 
    2184             : (defun ange-ftp-host-type (host &optional user)
    2185             :   "Return a symbol which represents the type of the HOST given.
    2186             : If the optional argument USER is given, attempts to guess the
    2187             : host-type by logging in as USER."
    2188           0 :   (cond ((null host) 'unix)
    2189             :         ;; Return `unix' if HOST is nil, since that's the most vanilla
    2190             :         ;; possible return value.
    2191           0 :         ((eq host ange-ftp-host-cache)
    2192           0 :          ange-ftp-host-type-cache)
    2193             :         ;; Trigger an ftp connection, in case we need to guess at the host type.
    2194           0 :         ((and user (ange-ftp-get-process host user) (eq host ange-ftp-host-cache))
    2195           0 :          ange-ftp-host-type-cache)
    2196             :         (t
    2197           0 :          (setq ange-ftp-host-cache host
    2198             :                ange-ftp-host-type-cache
    2199           0 :                (cond ((ange-ftp-dumb-unix-host host)
    2200             :                       'dumb-unix)
    2201             :                      ;;           ((and (fboundp 'ange-ftp-vos-host)
    2202             :                      ;;                 (ange-ftp-vos-host host))
    2203             :                      ;;            'vos)
    2204           0 :                      ((and (fboundp 'ange-ftp-vms-host)
    2205           0 :                            (ange-ftp-vms-host host))
    2206             :                       'vms)
    2207           0 :                      ((and (fboundp 'ange-ftp-mts-host)
    2208           0 :                            (ange-ftp-mts-host host))
    2209             :                       'mts)
    2210           0 :                      ((and (fboundp 'ange-ftp-cms-host)
    2211           0 :                            (ange-ftp-cms-host host))
    2212             :                       'cms)
    2213           0 :                      ((and (fboundp 'ange-ftp-bs2000-posix-host)
    2214           0 :                            (ange-ftp-bs2000-posix-host host))
    2215             :                       'text-unix)       ; POSIX is a non-ASCII Unix
    2216           0 :                      ((and (fboundp 'ange-ftp-bs2000-host)
    2217           0 :                            (ange-ftp-bs2000-host host))
    2218             :                       'bs2000)
    2219             :                      (t
    2220           0 :                       'unix))))))
    2221             : 
    2222             : ;; It would be nice to abstract the functions ange-ftp-TYPE-host and
    2223             : ;; ange-ftp-add-TYPE-host. The trick is to abstract these functions
    2224             : ;; without sacrificing speed. Also, having separate variables
    2225             : ;; ange-ftp-TYPE-regexp is more user friendly then requiring the user to
    2226             : ;; set an alist to indicate that a host is of a given type. Even with
    2227             : ;; automatic host type recognition, setting a regexp is still a good idea
    2228             : ;; (for efficiency) if you log into a particular non-UNIX host frequently.
    2229             : 
    2230             : (defvar ange-ftp-fix-name-func-alist nil
    2231             :   "Alist saying how to convert file name to the host's syntax.
    2232             : Association list of (TYPE . FUNC) pairs, where FUNC is a routine which can
    2233             : change a UNIX file name into a name more suitable for a host of type TYPE.")
    2234             : 
    2235             : (defvar ange-ftp-fix-dir-name-func-alist nil
    2236             :   "Alist saying how to convert directory name to the host's syntax.
    2237             : Association list of (TYPE . FUNC) pairs, where FUNC is a routine which can
    2238             : change UNIX directory name into a directory name more suitable for a host
    2239             : of type TYPE.")
    2240             : 
    2241             : ;; *** Perhaps the sense of this variable should be inverted, since there
    2242             : ;; *** is only 1 host type that can take ls-style listing options.
    2243             : (defvar ange-ftp-dumb-host-types '(dumb-unix)
    2244             :   "List of host types that can't take UNIX ls-style listing options.")
    2245             : 
    2246             : (defun ange-ftp-send-cmd (host user cmd &optional msg cont nowait)
    2247             :   "Find an FTP process connected to HOST logged in as USER and send it CMD.
    2248             : MSG is an optional status message to be output before and after issuing the
    2249             : command.
    2250             : See the documentation for `ange-ftp-raw-send-cmd' for a description of CONT
    2251             : and NOWAIT."
    2252             :   ;; Handle conversion to remote file name syntax and remote ls option
    2253             :   ;; capability.
    2254           0 :   (let ((cmd0 (car cmd))
    2255           0 :         (cmd1 (nth 1 cmd))
    2256           0 :         (ange-ftp-this-user user)
    2257           0 :         (ange-ftp-this-host host)
    2258           0 :         (ange-ftp-this-msg msg)
    2259             :         cmd2 cmd3 host-type fix-name-func result)
    2260             : 
    2261           0 :     (cond
    2262             : 
    2263             :      ;; pwd case (We don't care what host-type.)
    2264           0 :      ((null cmd1))
    2265             : 
    2266             :      ;; cmd == 'dir "remote-name" "local-name" "ls-switches"
    2267           0 :      ((progn
    2268           0 :        (setq cmd2 (nth 2 cmd)
    2269           0 :              host-type (ange-ftp-host-type host user))
    2270             :        ;; This will trigger an FTP login, if one doesn't exist
    2271           0 :        (eq cmd0 'dir))
    2272           0 :       (setq cmd1 (funcall
    2273           0 :                   (or (cdr (assq host-type ange-ftp-fix-dir-name-func-alist))
    2274           0 :                       'identity)
    2275           0 :                   cmd1)
    2276           0 :             cmd3 (nth 3 cmd))
    2277             :       ;; Need to deal with the HP-UX ftp bug. This should also allow us to
    2278             :       ;; resolve symlinks to directories on SysV machines. (Sebastian will
    2279             :       ;; be happy.)
    2280           0 :       (and (eq host-type 'unix)
    2281           0 :            (string-match "/\\'" cmd1)
    2282           0 :            (not (string-match "R" cmd3))
    2283           0 :            (setq cmd1 (concat cmd1 ".")))
    2284             : 
    2285             :       ;; Using "ls -flags foo" has several problems:
    2286             :       ;; - if foo is a symlink, we may get a single line showing the symlink
    2287             :       ;;   rather than the listing of the directory it points to.
    2288             :       ;; - if "foo" has spaces, the parsing of the command may be done wrong.
    2289             :       ;; - some version of netbsd's ftpd only accept a single argument after
    2290             :       ;;   `ls', which can either be the directory or the flags.
    2291             :       ;; So to work around those problems, we use "cd foo; ls -flags".
    2292             : 
    2293             :       ;; If the dir name contains a space, some ftp servers will
    2294             :       ;; refuse to list it.  We instead change directory to the
    2295             :       ;; directory in question and ls ".".
    2296           0 :       (when (string-match " " cmd1)
    2297             :         ;; Keep the result.  In case of failure, we will (see below)
    2298             :         ;; short-circuit CMD and return this result directly.
    2299           0 :         (setq result (ange-ftp-cd host user (nth 1 cmd) 'noerror))
    2300           0 :         (setq cmd1 "."))
    2301             : 
    2302             :       ;; If the remote ls can take switches, put them in
    2303           0 :       (unless (memq host-type ange-ftp-dumb-host-types)
    2304           0 :         (setq cmd0 'ls)
    2305             :         ;; We cd and then use `ls' with no directory argument.
    2306             :         ;; This works around a misfeature of some versions of netbsd ftpd
    2307             :         ;; where `ls' can only take one argument: either one set of flags
    2308             :         ;; or a file/directory name.
    2309             :         ;; If we're trying to `ls' a single file, this fails since we
    2310             :         ;; can't cd to a file.  We can't fix this problem here, tho, because
    2311             :         ;; at this point we don't know whether the argument is a file or
    2312             :         ;; a directory.  Such an `ls' is only ever used (apparently) from
    2313             :         ;; `insert-directory' when the `full-directory-p' argument is nil
    2314             :         ;; (which seems to only be used by dired when updating its display
    2315             :         ;; after operating on a set of files).  So we've changed
    2316             :         ;; `ange-ftp-insert-directory' such that in this case it gets
    2317             :         ;; a full listing of the directory and extracting the line
    2318             :         ;; corresponding to the requested file.
    2319           0 :         (unless (equal cmd1 ".")
    2320           0 :           (setq result (ange-ftp-cd host user (nth 1 cmd) 'noerror)))
    2321           0 :         (setq cmd1 cmd3)))
    2322             : 
    2323             :      ;; First argument is the remote name
    2324           0 :      ((progn
    2325           0 :         (setq fix-name-func (or (cdr (assq host-type
    2326           0 :                                            ange-ftp-fix-name-func-alist))
    2327           0 :                                 'identity))
    2328           0 :         (memq cmd0 '(get delete mkdir rmdir cd)))
    2329           0 :       (setq cmd1 (funcall fix-name-func cmd1)))
    2330             : 
    2331             :      ;; Second argument is the remote name
    2332           0 :      ((or (memq cmd0 '(append put chmod))
    2333           0 :           (and (eq cmd0 'quote) (member cmd1 '("mdtm" "size"))))
    2334           0 :       (setq cmd2 (funcall fix-name-func cmd2)))
    2335             :      ;; Both arguments are remote names
    2336           0 :      ((eq cmd0 'rename)
    2337           0 :       (setq cmd1 (funcall fix-name-func cmd1)
    2338           0 :             cmd2 (funcall fix-name-func cmd2))))
    2339             : 
    2340             :     ;; Turn the command into one long string
    2341           0 :     (setq cmd0 (symbol-name cmd0))
    2342           0 :     (setq cmd (concat cmd0
    2343           0 :                       (and cmd1 (concat " " cmd1))
    2344           0 :                       (and cmd2 (concat " " cmd2))))
    2345             : 
    2346             :     ;; Actually send the resulting command.
    2347           0 :     (if (and (consp result) (null (car result)))
    2348             :         ;; `ange-ftp-cd' has failed, so there's no point sending `cmd'.
    2349           0 :         result
    2350           0 :       (let (afsc-result
    2351             :             afsc-line)
    2352           0 :         (ange-ftp-raw-send-cmd
    2353           0 :          (ange-ftp-get-process host user)
    2354           0 :          cmd
    2355           0 :          msg
    2356           0 :          (list (lambda (result line host user cmd msg cont nowait)
    2357           0 :                  (or cont (setq afsc-result result
    2358           0 :                                 afsc-line line))
    2359           0 :                  (if result (ange-ftp-call-cont cont result line)
    2360           0 :                    (ange-ftp-raw-send-cmd
    2361           0 :                     (ange-ftp-get-process host user)
    2362           0 :                     cmd
    2363           0 :                     msg
    2364           0 :                     (list (lambda (result line cont)
    2365           0 :                             (or cont (setq afsc-result result
    2366           0 :                                            afsc-line line))
    2367           0 :                             (ange-ftp-call-cont cont result line))
    2368           0 :                           cont)
    2369           0 :                     nowait)))
    2370           0 :                host user cmd msg cont nowait)
    2371           0 :          nowait)
    2372             : 
    2373           0 :         (if nowait
    2374             :             nil
    2375           0 :           (if cont
    2376             :               nil
    2377           0 :             (cons afsc-result afsc-line)))))))
    2378             : 
    2379             : ;; It might be nice to message users about the host type identified,
    2380             : ;; but there is so much other messaging going on, it would not be
    2381             : ;; seen. No point in slowing things down just so users can read
    2382             : ;; a host type message.
    2383             : 
    2384             : (defconst ange-ftp-cms-name-template
    2385             :   (concat
    2386             :    "^[-A-Z0-9$*][-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?"
    2387             :    "[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?\\.[0-9][0-9][0-9A-Z]$"))
    2388             : (defconst ange-ftp-vms-name-template
    2389             :   "^[-A-Z0-9_$]+:\\[[-A-Z0-9_$]+\\(\\.[-A-Z0-9_$]+\\)*\\]$")
    2390             : (defconst ange-ftp-mts-name-template
    2391             :   "^[A-Z0-9._][A-Z0-9._][A-Z0-9._][A-Z0-9._]:$")
    2392             : (defconst ange-ftp-bs2000-filename-pubset-regexp
    2393             :   ":[A-Z0-9]+:"
    2394             :   "Valid pubset for an BS2000 file name.")
    2395             : (defconst ange-ftp-bs2000-filename-username-regexp
    2396             :   (concat
    2397             :    "\\$[A-Z0-9]*\\.")
    2398             :   "Valid username for an BS2000 file name.")
    2399             : (defconst ange-ftp-bs2000-filename-prefix-regexp
    2400             :   (concat
    2401             :    ange-ftp-bs2000-filename-pubset-regexp
    2402             :    ange-ftp-bs2000-filename-username-regexp)
    2403             :   "Valid prefix for an BS2000 file name (pubset and user).")
    2404             : (defconst ange-ftp-bs2000-name-template
    2405             :   (concat "^" ange-ftp-bs2000-filename-prefix-regexp "$"))
    2406             : 
    2407             : (defun ange-ftp-guess-host-type (host user)
    2408             :   "Guess the host type of HOST.
    2409             : Works by doing a pwd and examining the directory syntax."
    2410           0 :   (let ((host-type (ange-ftp-host-type host))
    2411           0 :         (key (concat host "/" user "/~")))
    2412           0 :     (if (eq host-type 'unix)
    2413             :         ;; Note that ange-ftp-host-type returns unix as the default value.
    2414           0 :         (save-match-data
    2415           0 :           (let* ((result (ange-ftp-get-pwd host user))
    2416           0 :                  (dir (car result))
    2417             :                  fix-name-func)
    2418           0 :             (cond ((null dir)
    2419           0 :                    (message "Warning! Unable to get home directory")
    2420           0 :                    (sit-for 1)
    2421           0 :                    (if (string-match
    2422             :                         "^450 No current working directory defined$"
    2423           0 :                         (cdr result))
    2424             : 
    2425             :                        ;; We'll assume that if pwd bombs with this
    2426             :                        ;; error message, then it's CMS.
    2427           0 :                        (progn
    2428           0 :                          (ange-ftp-add-cms-host host)
    2429           0 :                          (setq ange-ftp-host-cache host
    2430           0 :                                ange-ftp-host-type-cache 'cms))))
    2431             : 
    2432             :                   ;; try for VMS
    2433           0 :                   ((string-match ange-ftp-vms-name-template dir)
    2434           0 :                    (ange-ftp-add-vms-host host)
    2435             :                    ;; The add-host functions clear the host type cache.
    2436             :                    ;; Therefore, need to set the cache afterwards.
    2437           0 :                    (setq ange-ftp-host-cache host
    2438           0 :                          ange-ftp-host-type-cache 'vms))
    2439             : 
    2440             :                   ;; try for MTS
    2441           0 :                   ((string-match ange-ftp-mts-name-template dir)
    2442           0 :                    (ange-ftp-add-mts-host host)
    2443           0 :                    (setq ange-ftp-host-cache host
    2444           0 :                          ange-ftp-host-type-cache 'mts))
    2445             : 
    2446             :                   ;; try for CMS
    2447           0 :                   ((string-match ange-ftp-cms-name-template dir)
    2448           0 :                    (ange-ftp-add-cms-host host)
    2449           0 :                    (setq ange-ftp-host-cache host
    2450           0 :                          ange-ftp-host-type-cache 'cms))
    2451             : 
    2452             :                   ;; try for BS2000-POSIX
    2453           0 :                   ((ange-ftp-bs2000-posix-host host)
    2454           0 :                    (ange-ftp-add-bs2000-host host)
    2455           0 :                    (setq ange-ftp-host-cache host
    2456           0 :                          ange-ftp-host-type-cache 'text-unix))
    2457             :                   ;; try for BS2000
    2458           0 :                   ((and (string-match ange-ftp-bs2000-name-template dir)
    2459           0 :                         (not (ange-ftp-bs2000-posix-host host)))
    2460           0 :                    (ange-ftp-add-bs2000-host host)
    2461           0 :                    (setq ange-ftp-host-cache host
    2462           0 :                          ange-ftp-host-type-cache 'bs2000))
    2463             :                   ;; assume UN*X
    2464             :                   (t
    2465           0 :                    (setq ange-ftp-host-cache host
    2466           0 :                          ange-ftp-host-type-cache 'unix)))
    2467             : 
    2468             :             ;; Now that we have done a pwd, might as well put it in
    2469             :             ;; the expand-dir hashtable.
    2470           0 :             (let ((ange-ftp-this-user user)
    2471           0 :                   (ange-ftp-this-host host))
    2472           0 :               (setq fix-name-func (cdr (assq ange-ftp-host-type-cache
    2473           0 :                                              ange-ftp-fix-name-func-alist)))
    2474           0 :               (if fix-name-func
    2475           0 :                   (setq dir (funcall fix-name-func dir 'reverse))))
    2476           0 :             (puthash key dir ange-ftp-expand-dir-hashtable))))
    2477             : 
    2478             :     ;; In the special case of CMS make sure that know the
    2479             :     ;; expansion of the home minidisk now, because we will
    2480             :     ;; be doing a lot of cd's.
    2481           0 :     (if (and (eq host-type 'cms)
    2482           0 :              (not (ange-ftp-hash-entry-exists-p
    2483           0 :                    key ange-ftp-expand-dir-hashtable)))
    2484           0 :         (let ((dir (car (ange-ftp-get-pwd host user))))
    2485           0 :           (if dir
    2486           0 :               (puthash key (concat "/" dir) ange-ftp-expand-dir-hashtable)
    2487           0 :             (message "Warning! Unable to get home directory")
    2488           0 :             (sit-for 1))))))
    2489             : 
    2490             : 
    2491             : ;;;; ------------------------------------------------------------
    2492             : ;;;; Remote file and directory listing support.
    2493             : ;;;; ------------------------------------------------------------
    2494             : 
    2495             : ;; Returns whether HOST's FTP server doesn't like 'ls' or 'dir' commands
    2496             : ;; to take switch arguments.
    2497             : (defun ange-ftp-dumb-unix-host (host)
    2498           0 :   (and host ange-ftp-dumb-unix-host-regexp
    2499           0 :        (string-match-p ange-ftp-dumb-unix-host-regexp host)))
    2500             : 
    2501             : (defun ange-ftp-add-dumb-unix-host (host)
    2502             :   "Interactively add a given HOST to `ange-ftp-dumb-unix-host-regexp'."
    2503             :   (interactive
    2504           0 :    (list (read-string "Host: "
    2505           0 :                       (let ((name (or (buffer-file-name) default-directory)))
    2506           0 :                         (and name (car (ange-ftp-ftp-name name)))))))
    2507           0 :   (if (not (ange-ftp-dumb-unix-host host))
    2508           0 :       (setq ange-ftp-dumb-unix-host-regexp
    2509           0 :             (concat "^" (regexp-quote host) "$"
    2510           0 :                     (and ange-ftp-dumb-unix-host-regexp "\\|")
    2511           0 :                     ange-ftp-dumb-unix-host-regexp)
    2512           0 :             ange-ftp-host-cache nil)))
    2513             : 
    2514             : (defvar ange-ftp-parse-list-func-alist nil
    2515             :   "Alist saying how to parse directory listings for certain OS types.
    2516             : Association list of (TYPE . FUNC) pairs.  The FUNC is a routine which
    2517             : can parse the output from a DIR listing for a host of type TYPE.")
    2518             : 
    2519             : ;; With no-error nil, this function returns:
    2520             : ;; an error if file is not an ange-ftp-name
    2521             : ;;                      (This should never happen.)
    2522             : ;; an error if either the listing is unreadable or there is an ftp error.
    2523             : ;; the listing (a string), if everything works.
    2524             : ;;
    2525             : ;; With no-error t, it returns:
    2526             : ;; an error if not an ange-ftp-name
    2527             : ;; error if listing is unreadable (most likely caused by a slow connection)
    2528             : ;; nil if ftp error (this is because although asking to list a nonexistent
    2529             : ;;                   directory on a remote unix machine usually (except
    2530             : ;;                   maybe for dumb hosts) returns an ls error, but no
    2531             : ;;                   ftp error, if the same is done on a VMS machine,
    2532             : ;;                   an ftp error is returned. Need to trap the error
    2533             : ;;                   so we can go on and try to list the parent.)
    2534             : ;; the listing, if everything works.
    2535             : 
    2536             : ;; If WILDCARD is non-nil, then this implements the guts of insert-directory
    2537             : ;; in the wildcard case.  Then we make a relative directory listing
    2538             : ;; of FILE within the directory specified by `default-directory'.
    2539             : 
    2540             : (defvar ange-ftp-before-parse-ls-hook nil
    2541             :   "Normal hook run before parsing the text of an FTP directory listing.")
    2542             : 
    2543             : (defvar ange-ftp-after-parse-ls-hook nil
    2544             :   "Normal hook run after parsing the text of an FTP directory listing.")
    2545             : 
    2546             : (defun ange-ftp-ls (file lsargs parse &optional no-error wildcard)
    2547             :   "Return the output of a `DIR' or `ls' command done over FTP.
    2548             : FILE is the full name of the remote file, LSARGS is any args to pass to the
    2549             : `ls' command, and PARSE specifies that the output should be parsed and stored
    2550             : away in the internal cache."
    2551           0 :   (when (string-match "^--dired\\s-+" lsargs)
    2552           0 :     (setq lsargs (replace-match "" nil t lsargs)))
    2553             :   ;; If parse is t, we assume that file is a directory. i.e. we only parse
    2554             :   ;; full directory listings.
    2555           0 :   (let* ((ange-ftp-this-file (ange-ftp-expand-file-name file))
    2556           0 :          (parsed (ange-ftp-ftp-name ange-ftp-this-file)))
    2557           0 :     (if parsed
    2558           0 :         (let* ((host (nth 0 parsed))
    2559           0 :                (user (nth 1 parsed))
    2560           0 :                (name (ange-ftp-quote-string (nth 2 parsed)))
    2561           0 :                (key (directory-file-name ange-ftp-this-file))
    2562           0 :                (host-type (ange-ftp-host-type host user))
    2563           0 :                (dumb (memq host-type ange-ftp-dumb-host-types))
    2564             :                result
    2565             :                temp
    2566             :                lscmd parse-func)
    2567           0 :           (if (string-equal name "")
    2568           0 :               (setq name
    2569           0 :                     (ange-ftp-real-file-name-as-directory
    2570           0 :                      (ange-ftp-expand-dir host user "~"))))
    2571           0 :           (if (and ange-ftp-ls-cache-file
    2572           0 :                    (string-equal key ange-ftp-ls-cache-file)
    2573             :                    ;; Don't care about lsargs for dumb hosts.
    2574           0 :                    (or dumb (string-equal lsargs ange-ftp-ls-cache-lsargs)))
    2575           0 :               ange-ftp-ls-cache-res
    2576           0 :             (setq temp (ange-ftp-make-tmp-name host))
    2577           0 :             (if wildcard
    2578           0 :                 (progn
    2579           0 :                   (ange-ftp-cd host user (file-name-directory name))
    2580           0 :                   (setq lscmd (list 'ls file temp lsargs)))
    2581           0 :               (setq lscmd (list 'dir name temp lsargs)))
    2582           0 :             (unwind-protect
    2583           0 :                 (if (car (setq result (ange-ftp-send-cmd
    2584           0 :                                        host
    2585           0 :                                        user
    2586           0 :                                        lscmd
    2587           0 :                                        (format "Listing %s"
    2588           0 :                                                (ange-ftp-abbreviate-filename
    2589           0 :                                                 ange-ftp-this-file)))))
    2590           0 :                     (with-current-buffer (get-buffer-create
    2591           0 :                                           ange-ftp-data-buffer-name)
    2592           0 :                       (erase-buffer)
    2593           0 :                       (if (ange-ftp-real-file-readable-p temp)
    2594           0 :                           (ange-ftp-real-insert-file-contents temp)
    2595           0 :                         (sleep-for ange-ftp-retry-time)
    2596             :                                         ;wait for file to possibly appear
    2597           0 :                         (if (ange-ftp-real-file-readable-p temp)
    2598             :                             ;; Try again.
    2599           0 :                             (ange-ftp-real-insert-file-contents temp)
    2600           0 :                           (ange-ftp-error host user
    2601           0 :                                           (format
    2602             :                                            "list data file %s not readable"
    2603           0 :                                            temp))))
    2604             :                       ;; remove ^M inserted by the w32 ftp client
    2605           0 :                       (while (re-search-forward "\r$" nil t)
    2606           0 :                         (replace-match ""))
    2607           0 :                       (goto-char 1)
    2608           0 :                       (run-hooks 'ange-ftp-before-parse-ls-hook)
    2609           0 :                       (if parse
    2610           0 :                           (ange-ftp-set-files
    2611           0 :                            ange-ftp-this-file
    2612           0 :                            (if (setq
    2613             :                                 parse-func
    2614           0 :                                 (cdr (assq host-type
    2615           0 :                                            ange-ftp-parse-list-func-alist)))
    2616           0 :                                (funcall parse-func)
    2617           0 :                              (ange-ftp-parse-dired-listing lsargs))))
    2618             :                       ;; Place this hook here to convert the contents of the
    2619             :                       ;; buffer to a ls compatible format if the host system
    2620             :                       ;; that is being queried is other than Unix i.e. VMS
    2621             :                       ;; returns an ls format that really sucks.
    2622           0 :                       (run-hooks 'ange-ftp-after-parse-ls-hook)
    2623           0 :                       (setq ange-ftp-ls-cache-file key
    2624           0 :                             ange-ftp-ls-cache-lsargs lsargs
    2625             :                                         ; For dumb hosts-types this is
    2626             :                                         ; meaningless but harmless.
    2627           0 :                             ange-ftp-ls-cache-res (buffer-string))
    2628             :                       ;; (kill-buffer (current-buffer))
    2629           0 :                       (if (equal ange-ftp-ls-cache-res "total 0\n")
    2630             :                           ;; wu-ftpd seems to return a successful result
    2631             :                           ;; with an empty file-listing when doing a
    2632             :                           ;; `DIR /some/file/.' which leads ange-ftp to
    2633             :                           ;; believe that /some/file is a directory ;-(
    2634             :                           nil
    2635           0 :                         ange-ftp-ls-cache-res))
    2636           0 :                   (if no-error
    2637             :                       nil
    2638           0 :                     (ange-ftp-error host user
    2639           0 :                                     (concat "DIR failed: " (cdr result)))))
    2640           0 :               (ange-ftp-del-tmp-name temp))))
    2641           0 :       (error "Should never happen. Please report. Bug ref. no.: 1"))))
    2642             : 
    2643             : ;;;; ------------------------------------------------------------
    2644             : ;;;; Directory information caching support.
    2645             : ;;;; ------------------------------------------------------------
    2646             : 
    2647             : (defvar ange-ftp-add-file-entry-alist nil
    2648             :   "Alist saying how to add file entries on certain OS types.
    2649             : Association list of pairs (TYPE . FUNC), where FUNC is a function
    2650             : to be used to add a file entry for the OS TYPE.
    2651             : The main reason for this alist is to deal with file versions in VMS.")
    2652             : 
    2653             : (defvar ange-ftp-delete-file-entry-alist nil
    2654             :   "Alist saying how to delete files on certain OS types.
    2655             : Association list of pairs (TYPE . FUNC), where FUNC is a function
    2656             : to be used to delete a file entry for the OS TYPE.
    2657             : The main reason for this alist is to deal with file versions in VMS.")
    2658             : 
    2659             : (defun ange-ftp-add-file-entry (name &optional dir-p)
    2660             :   "Add a file entry for file NAME, if its directory info exists."
    2661           0 :   (funcall (or (cdr (assq (ange-ftp-host-type
    2662           0 :                            (car (ange-ftp-ftp-name name)))
    2663           0 :                           ange-ftp-add-file-entry-alist))
    2664           0 :                'ange-ftp-internal-add-file-entry)
    2665           0 :            name dir-p)
    2666           0 :   (setq ange-ftp-ls-cache-file nil))
    2667             : 
    2668             : (defun ange-ftp-delete-file-entry (name &optional dir-p)
    2669             :   "Delete the file entry for file NAME, if its directory info exists."
    2670           0 :   (funcall (or (cdr (assq (ange-ftp-host-type
    2671           0 :                            (car (ange-ftp-ftp-name name)))
    2672           0 :                           ange-ftp-delete-file-entry-alist))
    2673           0 :                'ange-ftp-internal-delete-file-entry)
    2674           0 :            name dir-p)
    2675           0 :   (setq ange-ftp-ls-cache-file nil))
    2676             : 
    2677             : (defmacro ange-ftp-parse-filename ()
    2678             :   ;;Extract the filename from the current line of a dired-like listing.
    2679           1 :   `(save-match-data
    2680             :      (let ((eol (progn (end-of-line) (point))))
    2681             :        (beginning-of-line)
    2682             :        (if (re-search-forward directory-listing-before-filename-regexp eol t)
    2683           1 :            (buffer-substring (point) eol)))))
    2684             : 
    2685             : ;; This deals with the F switch. Should also do something about
    2686             : ;; unquoting names obtained with the SysV b switch and the GNU Q
    2687             : ;; switch. See Sebastian's dired-get-filename.
    2688             : 
    2689             : (defun ange-ftp-ls-parser (switches)
    2690             :   ;; Meant to be called by ange-ftp-parse-dired-listing
    2691           0 :   (let ((tbl (make-hash-table :test 'equal))
    2692           0 :         (used-F (and (stringp switches)
    2693           0 :                      (string-match "F" switches)))
    2694             :         file-type symlink directory file)
    2695           0 :     (while (setq file (ange-ftp-parse-filename))
    2696           0 :       (beginning-of-line)
    2697           0 :       (skip-chars-forward "\t 0-9")
    2698           0 :       (setq file-type (following-char)
    2699           0 :             directory (eq file-type ?d))
    2700           0 :       (if (eq file-type ?l)
    2701           0 :           (let ((end (string-match " -> " file)))
    2702           0 :             (if end
    2703             :                 ;; Sometimes `ls' appends a @ at the end of the target.
    2704           0 :                 (setq symlink (substring file (match-end 0)
    2705           0 :                                          (string-match "@\\'" file))
    2706           0 :                       file (substring file 0 end))
    2707             :               ;; Shouldn't happen
    2708           0 :               (setq symlink "")))
    2709           0 :         (setq symlink nil))
    2710             :       ;; Only do a costly regexp search if the F switch was used.
    2711           0 :       (if (and used-F
    2712           0 :                (not (string-equal file ""))
    2713           0 :                (looking-at
    2714           0 :                 ".[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"))
    2715           0 :           (let ((socket (eq file-type ?s))
    2716             :                 (executable
    2717           0 :                  (and (not symlink) ; x bits don't mean a thing for symlinks
    2718           0 :                       (string-match
    2719             :                        "[xst]"
    2720           0 :                        (concat (match-string 1)
    2721           0 :                                (match-string 2)
    2722           0 :                                (match-string 3))))))
    2723             :             ;; Some ls's with the F switch mark symlinks with an @ (ULTRIX)
    2724             :             ;; and others don't. (sigh...) Beware, that some Unix's don't
    2725             :             ;; seem to believe in the F-switch
    2726           0 :             (if (or (and symlink (string-match "@\\'" file))
    2727           0 :                     (and directory (string-match "/\\'" file))
    2728           0 :                     (and executable (string-match "*\\'" file))
    2729           0 :                     (and socket (string-match "=\\'" file)))
    2730           0 :                 (setq file (substring file 0 -1)))))
    2731           0 :       (puthash file (or symlink directory) tbl)
    2732           0 :       (forward-line 1))
    2733           0 :     (puthash "." t tbl)
    2734           0 :     (puthash ".." t tbl)
    2735           0 :     tbl))
    2736             : 
    2737             : ;;; The dl stuff for descriptive listings
    2738             : 
    2739             : (defvar ange-ftp-dl-dir-regexp nil
    2740             :   "Regexp matching directories which are listed in dl format.
    2741             : This regexp should not be anchored with a trailing `$', because it should
    2742             : match subdirectories as well.")
    2743             : 
    2744             : (defun ange-ftp-add-dl-dir (dir)
    2745             :   "Interactively add a DIR to `ange-ftp-dl-dir-regexp'."
    2746             :   (interactive
    2747           0 :    (list (read-string "Directory: "
    2748           0 :                       (let ((name (or (buffer-file-name) default-directory)))
    2749           0 :                         (and name (ange-ftp-ftp-name name)
    2750           0 :                              (file-name-directory name))))))
    2751           0 :   (if (not (and ange-ftp-dl-dir-regexp
    2752           0 :                 (string-match ange-ftp-dl-dir-regexp dir)))
    2753           0 :       (setq ange-ftp-dl-dir-regexp
    2754           0 :             (concat "^" (regexp-quote dir)
    2755           0 :                     (and ange-ftp-dl-dir-regexp "\\|")
    2756           0 :                     ange-ftp-dl-dir-regexp))))
    2757             : 
    2758             : (defmacro ange-ftp-dl-parser ()
    2759             :   ;; Parse the current buffer, which is assumed to be a descriptive
    2760             :   ;; listing, and return a hashtable.
    2761           1 :   `(let ((tbl (make-hash-table :test 'equal)))
    2762             :      (while (not (eobp))
    2763             :        (puthash
    2764             :         (buffer-substring (point)
    2765             :                           (progn
    2766             :                             (skip-chars-forward "^ /\n")
    2767             :                             (point)))
    2768             :         (eq (following-char) ?/)
    2769             :         tbl)
    2770             :        (forward-line 1))
    2771             :      (puthash "." t tbl)
    2772             :      (puthash ".." t tbl)
    2773           1 :      tbl))
    2774             : 
    2775             : ;; Parse the current buffer which is assumed to be in a dired-like listing
    2776             : ;; format, and return a hashtable as the result. If the listing is not really
    2777             : ;; a listing, then return nil.
    2778             : 
    2779             : (defun ange-ftp-parse-dired-listing (&optional switches)
    2780           0 :   (save-match-data
    2781           0 :     (cond
    2782           0 :      ((looking-at "^total [0-9]+$")
    2783           0 :       (forward-line 1)
    2784             :       ;; Some systems put in a blank line here.
    2785           0 :       (if (eolp) (forward-line 1))
    2786           0 :       (ange-ftp-ls-parser switches))
    2787           0 :      ((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
    2788             :       ;; It's an ls error message.
    2789             :       nil)
    2790           0 :      ((eobp) ; i.e. (zerop (buffer-size))
    2791             :       ;; This could be one of:
    2792             :       ;; (1) An Ultrix ls error message
    2793             :       ;; (2) A listing with the A switch of an empty directory
    2794             :       ;;     on a machine which doesn't give a total line.
    2795             :       ;; (3) The twilight zone.
    2796             :       ;; We'll assume (1) for now.
    2797             :       nil)
    2798           0 :      ((re-search-forward directory-listing-before-filename-regexp nil t)
    2799           0 :       (beginning-of-line)
    2800           0 :       (ange-ftp-ls-parser switches))
    2801           0 :      ((re-search-forward "^[^ \n\t]+ +\\([0-9]+\\|-\\|=\\) " nil t)
    2802             :       ;; It's a dl listing (I hope).
    2803             :       ;; file is bound by the call to ange-ftp-ls
    2804           0 :       (ange-ftp-add-dl-dir ange-ftp-this-file)
    2805           0 :       (beginning-of-line)
    2806           0 :       (ange-ftp-dl-parser))
    2807           0 :      (t nil))))
    2808             : 
    2809             : (defun ange-ftp-set-files (directory files)
    2810             :   "For a given DIRECTORY, set or change the associated FILES hashtable."
    2811           0 :   (and files (puthash (file-name-as-directory directory)
    2812           0 :                       files ange-ftp-files-hashtable)))
    2813             : 
    2814             : (defun ange-ftp-switches-ok (switches)
    2815             :   "Return SWITCHES (a string) if suitable for use with ls over ftp."
    2816           0 :   (and (stringp switches)
    2817             :        ;; We allow the --almost-all switch, which lists all files
    2818             :        ;; except "." and "..".  This is OK because we manually
    2819             :        ;; insert these entries in the hash table.
    2820           0 :        (string-match
    2821             :         "--\\(almost-\\)?all\\>\\|\\(\\`\\| \\)-[[:alpha:]]*[aA]"
    2822           0 :         switches)
    2823             :        ;; Disallow other long flags except --(almost-)all.
    2824           0 :        (not (string-match "\\(\\`\\| \\)--\\w+"
    2825           0 :                           (replace-regexp-in-string
    2826             :                            "--\\(almost-\\)?all\\>" ""
    2827           0 :                            switches)))
    2828             :        ;; Must include 'l'.
    2829           0 :        (string-match "\\(\\`\\| \\)-[[:alpha:]]*l" switches)
    2830             :        ;; Disallow recursive flag.
    2831           0 :        (not (string-match
    2832           0 :              "\\(\\`\\| \\)-[[:alpha:]]*R" switches))
    2833           0 :        switches))
    2834             : 
    2835             : (defun ange-ftp-get-files (directory &optional no-error)
    2836             :   "Given a DIRECTORY, return a hashtable of file entries.
    2837             : This will give an error or return nil, depending on the value of
    2838             : NO-ERROR, if a listing for DIRECTORY cannot be obtained."
    2839           0 :   (setq directory (file-name-as-directory directory)) ;normalize
    2840           0 :   (or (gethash directory ange-ftp-files-hashtable)
    2841           0 :       (save-match-data
    2842           0 :         (and (ange-ftp-ls directory
    2843             :                           ;; This is an efficiency hack. We try to
    2844             :                           ;; anticipate what sort of listing dired
    2845             :                           ;; might want, and cache just such a listing.
    2846           0 :                           (or (and (boundp 'dired-actual-switches)
    2847           0 :                                    (ange-ftp-switches-ok dired-actual-switches))
    2848           0 :                               (and (boundp 'dired-listing-switches)
    2849           0 :                                    (ange-ftp-switches-ok
    2850           0 :                                     dired-listing-switches))
    2851           0 :                               "-al")
    2852           0 :                           t no-error)
    2853           0 :              (gethash directory ange-ftp-files-hashtable)))))
    2854             : 
    2855             : ;; Given NAME, return the file part that can be used for looking up the
    2856             : ;; file's entry in a hashtable.
    2857             : (defmacro ange-ftp-get-file-part (name)
    2858           8 :   `(let ((file (file-name-nondirectory ,name)))
    2859             :      (if (string-equal file "")
    2860             :          "."
    2861           8 :        file)))
    2862             : 
    2863             : ;; Return whether ange-ftp-file-entry-p and ange-ftp-get-file-entry are
    2864             : ;; allowed to determine if NAME is a sub-directory by listing it directly,
    2865             : ;; rather than listing its parent directory. This is used for efficiency so
    2866             : ;; that a wasted listing is not done:
    2867             : ;; 1. When looking for a .dired file in dired-x.el.
    2868             : ;; 2. The syntax of FILE and DIR make it impossible that FILE could be a valid
    2869             : ;;     subdirectory. This is of course an OS dependent judgment.
    2870             : 
    2871             : (defvar dired-local-variables-file)
    2872             : (defmacro ange-ftp-allow-child-lookup (dir file)
    2873           2 :   `(not
    2874           2 :     (let* ((efile ,file)                ; expand once.
    2875           2 :            (edir ,dir)
    2876             :            (parsed (ange-ftp-ftp-name edir))
    2877             :            (host-type (ange-ftp-host-type
    2878             :                        (car parsed))))
    2879             :       (or
    2880             :        ;; Deal with dired
    2881             :        (and (boundp 'dired-local-variables-file) ; in the dired-x package
    2882             :             (stringp dired-local-variables-file)
    2883             :             (string-equal dired-local-variables-file efile))
    2884             :        ;; No dots in dir names in vms.
    2885             :        (and (eq host-type 'vms)
    2886             :             (string-match "\\." efile))
    2887             :        ;; No subdirs in mts of cms.
    2888             :        (and (memq host-type '(mts cms))
    2889             :             (not (string-equal "/" (nth 2 parsed))))
    2890             :        ;; No dots in pseudo-dir names in bs2000.
    2891             :        (and (eq host-type 'bs2000)
    2892           2 :             (string-match "\\." efile))))))
    2893             : 
    2894             : (defun ange-ftp-file-entry-p (name)
    2895             :   "Given NAME, return whether there is a file entry for it."
    2896           0 :   (let* ((name (directory-file-name name))
    2897           0 :          (dir (file-name-directory name))
    2898           0 :          (ent (gethash dir ange-ftp-files-hashtable))
    2899           0 :          (file (ange-ftp-get-file-part name)))
    2900           0 :     (if ent
    2901           0 :         (ange-ftp-hash-entry-exists-p file ent)
    2902           0 :       (or (and (ange-ftp-allow-child-lookup dir file)
    2903           0 :                (setq ent (ange-ftp-get-files name t))
    2904             :                ;; Try a child lookup. i.e. try to list file as a
    2905             :                ;; subdirectory of dir. This is a good idea because
    2906             :                ;; we may not have read permission for file's parent. Also,
    2907             :                ;; people tend to work down directory trees anyway. We use
    2908             :                ;; no-error ;; because if file does not exist as a subdir.,
    2909             :                ;; then dumb hosts will give an ftp error. Smart unix hosts
    2910             :                ;; will simply send back the ls
    2911             :                ;; error message.
    2912           0 :                (gethash "." ent))
    2913             :           ;; Child lookup failed, so try the parent.
    2914           0 :           (ange-ftp-hash-entry-exists-p
    2915           0 :            file (ange-ftp-get-files dir 'no-error))))))
    2916             : 
    2917             : (defun ange-ftp-get-file-entry (name)
    2918             :   "Given NAME, return the given file entry.
    2919             : The entry will be either t for a directory, nil for a normal file,
    2920             : or a string for a symlink.  If the file isn't in the hashtable,
    2921             : this also returns nil."
    2922           0 :   (let* ((name (directory-file-name name))
    2923           0 :          (dir (file-name-directory name))
    2924           0 :          (ent (gethash dir ange-ftp-files-hashtable))
    2925           0 :          (file (ange-ftp-get-file-part name)))
    2926           0 :     (if ent
    2927           0 :         (gethash file ent)
    2928           0 :       (or (and (ange-ftp-allow-child-lookup dir file)
    2929           0 :                (setq ent (ange-ftp-get-files name t))
    2930           0 :                (gethash "." ent))
    2931             :           ;; i.e. it's a directory by child lookup
    2932           0 :           (and (setq ent (ange-ftp-get-files dir t))
    2933           0 :                (gethash file ent))))))
    2934             : 
    2935             : (defun ange-ftp-internal-delete-file-entry (name &optional dir-p)
    2936           0 :   (when dir-p
    2937           0 :     (setq name (file-name-as-directory name))
    2938           0 :     (remhash name ange-ftp-files-hashtable)
    2939           0 :     (setq name (directory-file-name name)))
    2940             :   ;; Note that file-name-as-directory followed by directory-file-name
    2941             :   ;; serves to canonicalize directory file names to their unix form.
    2942             :   ;; i.e. in VMS, FOO.DIR -> FOO/ -> FOO
    2943           0 :   (let ((files (gethash (file-name-directory name) ange-ftp-files-hashtable)))
    2944           0 :     (if files
    2945           0 :         (remhash (ange-ftp-get-file-part name) files))))
    2946             : 
    2947             : (defun ange-ftp-internal-add-file-entry (name &optional dir-p)
    2948           0 :   (and dir-p
    2949           0 :        (setq name (directory-file-name name)))
    2950           0 :   (let ((files (gethash (file-name-directory name) ange-ftp-files-hashtable)))
    2951           0 :     (if files
    2952           0 :         (puthash (ange-ftp-get-file-part name) dir-p files))))
    2953             : 
    2954             : (defun ange-ftp-wipe-file-entries (host user)
    2955             :   "Get rid of entry for HOST, USER pair from file entry information hashtable."
    2956           0 :   (let ((new-tbl (make-hash-table :test 'equal
    2957           0 :                                   :size (hash-table-size
    2958           0 :                                          ange-ftp-files-hashtable))))
    2959           0 :     (maphash
    2960             :      (lambda (key val)
    2961           0 :        (let ((parsed (ange-ftp-ftp-name key)))
    2962           0 :          (if parsed
    2963           0 :              (let ((h (nth 0 parsed))
    2964           0 :                    (u (nth 1 parsed)))
    2965           0 :                (or (and (equal host h) (equal user u))
    2966           0 :                    (puthash key val new-tbl))))))
    2967           0 :      ange-ftp-files-hashtable)
    2968           0 :     (setq ange-ftp-files-hashtable new-tbl)))
    2969             : 
    2970             : ;;;; ------------------------------------------------------------
    2971             : ;;;; File transfer mode support.
    2972             : ;;;; ------------------------------------------------------------
    2973             : 
    2974             : (defun ange-ftp-set-binary-mode (host user)
    2975             :   "Tell the FTP process for the given HOST & USER to switch to binary mode."
    2976             :   ;; FIXME: We should keep track of the current mode, so as to avoid
    2977             :   ;; unnecessary roundtrips.
    2978           0 :   (let ((result (ange-ftp-send-cmd host user '(type "binary"))))
    2979           0 :     (if (not (car result))
    2980           0 :         (ange-ftp-error host user (concat "BINARY failed: " (cdr result)))
    2981           0 :       (with-current-buffer (process-buffer (ange-ftp-get-process host user))
    2982           0 :         (and ange-ftp-binary-hash-mark-size
    2983           0 :              (setq ange-ftp-hash-mark-unit
    2984           0 :                    (ash ange-ftp-binary-hash-mark-size -4)))))))
    2985             : 
    2986             : (defun ange-ftp-set-ascii-mode (host user)
    2987             :   "Tell the FTP process for the given HOST & USER to switch to ASCII mode."
    2988             :   ;; FIXME: We should keep track of the current mode, so as to avoid
    2989             :   ;; unnecessary roundtrips.
    2990           0 :   (let ((result (ange-ftp-send-cmd host user '(type "ascii"))))
    2991           0 :     (if (not (car result))
    2992           0 :         (ange-ftp-error host user (concat "ASCII failed: " (cdr result)))
    2993           0 :       (with-current-buffer (process-buffer (ange-ftp-get-process host user))
    2994           0 :         (and ange-ftp-ascii-hash-mark-size
    2995           0 :              (setq ange-ftp-hash-mark-unit
    2996           0 :                    (ash ange-ftp-ascii-hash-mark-size -4)))))))
    2997             : 
    2998             : (defun ange-ftp-cd (host user dir &optional noerror)
    2999           0 :   (let ((result (ange-ftp-send-cmd host user (list 'cd dir) "Doing CD")))
    3000           0 :     (if noerror result
    3001           0 :       (or (car result)
    3002           0 :           (ange-ftp-error host user (concat "CD failed: " (cdr result)))))))
    3003             : 
    3004             : (defun ange-ftp-get-pwd (host user)
    3005             :   "Attempt to get the current working directory for the given HOST/USER pair.
    3006             : Returns (DIR . LINE) where DIR is either the directory or nil if not found,
    3007             : and LINE is the relevant success or fail line from the FTP-client."
    3008           0 :   (let* ((result (ange-ftp-send-cmd host user '(pwd) "Getting PWD"))
    3009           0 :          (line (cdr result))
    3010             :          dir)
    3011           0 :     (if (car result)
    3012           0 :         (save-match-data
    3013           0 :           (and (or (string-match "\"\\([^\"]*\\)\"" line)
    3014             :                    ;; Some clients cache the value and return it in
    3015             :                    ;; this way without asking the server.  (Bug#15058)
    3016           0 :                    (string-match "^Remote directory: \\(.*\\)" line)
    3017           0 :                    (string-match " \\([^ ]+\\) " line))       ; stone-age VMS servers!
    3018           0 :                (setq dir (match-string 1 line)))))
    3019           0 :     (cons dir line)))
    3020             : 
    3021             : ;;; ------------------------------------------------------------
    3022             : ;;; expand-file-name and friends...which currently don't work
    3023             : ;;; ------------------------------------------------------------
    3024             : 
    3025             : (defun ange-ftp-expand-dir (host user dir)
    3026             :   "Return the result of doing a PWD in the current FTP session.
    3027             : Use the connection to machine HOST
    3028             : logged in as user USER and cd'd to directory DIR."
    3029           0 :   (let* ((host-type (ange-ftp-host-type host user))
    3030             :          ;; It is more efficient to call ange-ftp-host-type
    3031             :          ;; before binding res, because ange-ftp-host-type sometimes
    3032             :          ;; adds to the info in the expand-dir-hashtable.
    3033             :          (fix-name-func
    3034           0 :           (cdr (assq host-type ange-ftp-fix-name-func-alist)))
    3035           0 :          (key (concat host "/" user "/" dir))
    3036           0 :          (res (gethash key ange-ftp-expand-dir-hashtable)))
    3037           0 :     (or res
    3038           0 :         (progn
    3039           0 :           (or
    3040           0 :            (string-equal user "anonymous")
    3041           0 :            (string-equal user "ftp")
    3042           0 :            (not (eq host-type 'unix))
    3043           0 :            (let* ((ange-ftp-good-msgs (concat ange-ftp-expand-dir-regexp
    3044             :                                               "\\|"
    3045           0 :                                               ange-ftp-good-msgs))
    3046           0 :                   (result (ange-ftp-send-cmd host user
    3047           0 :                                              (list 'get dir null-device)
    3048           0 :                                              (format "expanding %s" dir)))
    3049           0 :                   (line (cdr result)))
    3050           0 :              (setq res
    3051           0 :                    (if (string-match ange-ftp-expand-dir-regexp line)
    3052           0 :                        (match-string 1 line)))))
    3053           0 :           (or res
    3054           0 :               (if (string-equal dir "~")
    3055           0 :                   (setq res (car (ange-ftp-get-pwd host user)))
    3056           0 :                 (let ((home (ange-ftp-expand-dir host user "~")))
    3057           0 :                   (unwind-protect
    3058           0 :                       (and (ange-ftp-cd host user dir)
    3059           0 :                            (setq res (car (ange-ftp-get-pwd host user))))
    3060           0 :                     (ange-ftp-cd host user home)))))
    3061           0 :           (if res
    3062           0 :               (let ((ange-ftp-this-user user)
    3063           0 :                     (ange-ftp-this-host host))
    3064           0 :                 (if fix-name-func
    3065           0 :                     (setq res (funcall fix-name-func res 'reverse)))
    3066           0 :                 (puthash key res ange-ftp-expand-dir-hashtable)))
    3067           0 :           res))))
    3068             : 
    3069             : (defun ange-ftp-canonize-filename (n)
    3070             :   "Take a string N and short-circuit //, /. and /.."
    3071           0 :   (if (string-match "[^:]+//" n)              ;don't upset Apollo users
    3072           0 :       (setq n (substring n (1- (match-end 0)))))
    3073           0 :   (let ((parsed (ange-ftp-ftp-name n)))
    3074           0 :     (if parsed
    3075           0 :         (let ((host (car parsed))
    3076           0 :               (user (nth 1 parsed))
    3077           0 :               (name (nth 2 parsed)))
    3078             : 
    3079             :           ;; See if remote name is absolute.  If so then just expand it and
    3080             :           ;; replace the name component of the overall name.
    3081           0 :           (cond ((string-match "\\`/" name)
    3082           0 :                  name)
    3083             : 
    3084             :                 ;; Name starts with ~ or ~user.  Resolve that part of the name
    3085             :                 ;; making it absolute then re-expand it.
    3086           0 :                 ((string-match "\\`~[^/]*" name)
    3087           0 :                  (let* ((tilda (match-string 0 name))
    3088           0 :                         (rest (substring name (match-end 0)))
    3089           0 :                         (dir (ange-ftp-expand-dir host user tilda)))
    3090           0 :                    (if dir
    3091             :                        ;; C-x d /ftp:anonymous@ftp.gnu.org:~/ RET
    3092             :                        ;; seems to cause `rest' to sometimes be empty.
    3093             :                        ;; Maybe it's an error for `rest' to be empty here,
    3094             :                        ;; but until we figure this out, this quick fix
    3095             :                        ;; seems to do the trick.
    3096           0 :                        (setq name (cond ((string-equal rest "") dir)
    3097           0 :                                         ((string-equal dir "/") rest)
    3098           0 :                                         (t (concat dir rest))))
    3099           0 :                      (error "User \"%s\" is not known"
    3100           0 :                             (substring tilda 1)))))
    3101             : 
    3102             :                 ;; relative name.  Tack on homedir and re-expand.
    3103             :                 (t
    3104           0 :                  (let ((dir (ange-ftp-expand-dir host user "~")))
    3105           0 :                    (if dir
    3106           0 :                        (setq name (concat
    3107           0 :                                    (ange-ftp-real-file-name-as-directory dir)
    3108           0 :                                    name))
    3109           0 :                      (error "Unable to obtain CWD")))))
    3110             : 
    3111             :           ;; If name starts with //, preserve that, for apollo system.
    3112           0 :           (unless (string-match "\\`//" name)
    3113           0 :             (if (not (eq system-type 'windows-nt))
    3114           0 :                 (setq name (ange-ftp-real-expand-file-name name))
    3115             :               ;; Windows UNC default dirs do not make sense for ftp.
    3116           0 :               (setq name (if (and default-directory
    3117           0 :                                   (string-match "\\`//" default-directory))
    3118           0 :                              (ange-ftp-real-expand-file-name name "c:/")
    3119           0 :                            (ange-ftp-real-expand-file-name name)))
    3120             :               ;; Strip off possible drive specifier.
    3121           0 :               (if (string-match "\\`[a-zA-Z]:" name)
    3122           0 :                   (setq name (substring name 2))))
    3123           0 :             (if (string-match "\\`//" name)
    3124           0 :                 (setq name (substring name 1))))
    3125             : 
    3126             :           ;; Now substitute the expanded name back into the overall filename.
    3127           0 :           (ange-ftp-replace-name-component n name))
    3128             : 
    3129             :       ;; non-ange-ftp name.  Just expand normally.
    3130           0 :       (if (eq (string-to-char n) ?/)
    3131           0 :           (ange-ftp-real-expand-file-name n)
    3132           0 :         (ange-ftp-real-expand-file-name
    3133           0 :          (ange-ftp-real-file-name-nondirectory n)
    3134           0 :          (ange-ftp-real-file-name-directory n))))))
    3135             : 
    3136             : (defun ange-ftp-expand-file-name (name &optional default)
    3137             :   "Documented as `expand-file-name'."
    3138           0 :   (save-match-data
    3139           0 :     (setq default (or default default-directory))
    3140           0 :     (cond
    3141           0 :      ((ange-ftp-ftp-name name)
    3142             :       ;; `default' is irrelevant.
    3143           0 :       (ange-ftp-canonize-filename name))
    3144           0 :      ((file-name-absolute-p name)
    3145             :       ;; `name' is absolute but is not an ange-ftp name => not ange-ftp.
    3146           0 :       (ange-ftp-real-expand-file-name name "/"))
    3147           0 :      ((ange-ftp-canonize-filename
    3148           0 :        (concat (file-name-as-directory default) name))))))
    3149             : 
    3150             : ;;; These are problems--they are currently not enabled.
    3151             : 
    3152             : (defvar ange-ftp-file-name-as-directory-alist nil
    3153             :   "Association list of (TYPE . FUNC) pairs.
    3154             : FUNC converts a filename to a directory name for the operating
    3155             : system TYPE.")
    3156             : 
    3157             : (defun ange-ftp-file-name-as-directory (name)
    3158             :   "Documented as `file-name-as-directory'."
    3159           0 :   (let ((parsed (ange-ftp-ftp-name name)))
    3160           0 :     (if parsed
    3161           0 :         (if (string-equal (nth 2 parsed) "")
    3162           0 :             name
    3163           0 :           (funcall (or (cdr (assq
    3164           0 :                              (ange-ftp-host-type (car parsed))
    3165           0 :                              ange-ftp-file-name-as-directory-alist))
    3166           0 :                        'ange-ftp-real-file-name-as-directory)
    3167           0 :                    name))
    3168           0 :       (ange-ftp-real-file-name-as-directory name))))
    3169             : 
    3170             : (defun ange-ftp-file-name-directory (name)
    3171             :   "Documented as `file-name-directory'."
    3172           0 :   (let ((parsed (ange-ftp-ftp-name name)))
    3173           0 :     (if parsed
    3174           0 :         (let ((filename (nth 2 parsed)))
    3175           0 :           (if (string-match-p "\\`~[^/]*\\'" filename)
    3176           0 :               name
    3177           0 :             (ange-ftp-replace-name-component
    3178           0 :              name
    3179           0 :              (ange-ftp-real-file-name-directory filename))))
    3180           0 :       (ange-ftp-real-file-name-directory name))))
    3181             : 
    3182             : (defun ange-ftp-file-name-nondirectory (name)
    3183             :   "Documented as `file-name-nondirectory'."
    3184           0 :   (let ((parsed (ange-ftp-ftp-name name)))
    3185           0 :     (if parsed
    3186           0 :         (let ((filename (nth 2 parsed)))
    3187           0 :           (if (string-match-p "\\`~[^/]*\\'" filename)
    3188             :               ""
    3189           0 :             (ange-ftp-real-file-name-nondirectory filename)))
    3190           0 :       (ange-ftp-real-file-name-nondirectory name))))
    3191             : 
    3192             : (defun ange-ftp-directory-file-name (dir)
    3193             :   "Documented as `directory-file-name'."
    3194           0 :   (let ((parsed (ange-ftp-ftp-name dir)))
    3195           0 :     (if parsed
    3196           0 :         (ange-ftp-replace-name-component
    3197           0 :          dir
    3198           0 :          (ange-ftp-real-directory-file-name (nth 2 parsed)))
    3199           0 :       (ange-ftp-real-directory-file-name dir))))
    3200             : 
    3201             : 
    3202             : ;;; Hooks that handle Emacs primitives.
    3203             : 
    3204             : ;; Returns non-nil if should transfer FILE in binary mode.
    3205             : (defun ange-ftp-binary-file (file)
    3206           0 :   (string-match-p ange-ftp-binary-file-name-regexp file))
    3207             : 
    3208             : (defun ange-ftp-write-region
    3209             :     (start end filename &optional append visit _lockname mustbenew)
    3210           0 :   (setq filename (expand-file-name filename))
    3211           0 :   (when mustbenew
    3212           0 :     (ange-ftp-barf-or-query-if-file-exists
    3213           0 :      filename "overwrite" (not (eq mustbenew 'excl))))
    3214           0 :   (let ((parsed (ange-ftp-ftp-name filename)))
    3215           0 :     (if parsed
    3216           0 :         (let* ((host (nth 0 parsed))
    3217           0 :                (user (nth 1 parsed))
    3218           0 :                (name (ange-ftp-quote-string (nth 2 parsed)))
    3219           0 :                (temp (ange-ftp-make-tmp-name host))
    3220             :                ;; What we REALLY need here is a way to determine if the mode
    3221             :                ;; of the transfer is irrelevant, i.e. we can use binary mode
    3222             :                ;; regardless. Maybe a system-type to host-type lookup?
    3223           0 :                (binary (ange-ftp-binary-file filename))
    3224           0 :                (cmd (if append 'append 'put))
    3225           0 :                (abbr (ange-ftp-abbreviate-filename filename))
    3226             :                ;; we need to reset `last-coding-system-used' to its
    3227             :                ;; value immediately after calling the real write-region,
    3228             :                ;; so that `basic-save-buffer' doesn't see whatever value
    3229             :                ;; might be used when communicating with the ftp process.
    3230           0 :                (coding-system-used last-coding-system-used))
    3231           0 :           (unwind-protect
    3232           0 :               (progn
    3233           0 :                 (let ((filename (buffer-file-name))
    3234           0 :                       (mod-p (buffer-modified-p)))
    3235           0 :                   (unwind-protect
    3236           0 :                       (progn
    3237           0 :                         (ange-ftp-real-write-region start end temp nil
    3238           0 :                                                     (or visit 'quiet))
    3239           0 :                         (setq coding-system-used last-coding-system-used))
    3240             :                     ;; cleanup forms
    3241           0 :                     (setq coding-system-used last-coding-system-used)
    3242           0 :                     (setq buffer-file-name filename)
    3243           0 :                     (restore-buffer-modified-p mod-p)))
    3244           0 :                 (if binary
    3245           0 :                     (ange-ftp-set-binary-mode host user))
    3246             : 
    3247             :                 ;; tell the process filter what size the transfer will be.
    3248           0 :                 (let ((attr (file-attributes temp)))
    3249           0 :                   (if attr
    3250           0 :                       (ange-ftp-set-xfer-size host user (nth 7 attr))))
    3251             : 
    3252             :                 ;; put or append the file.
    3253           0 :                 (let ((result (ange-ftp-send-cmd host user
    3254           0 :                                                  (list cmd temp name)
    3255           0 :                                                  (format "Writing %s" abbr))))
    3256           0 :                   (or (car result)
    3257           0 :                       (signal 'ftp-error
    3258           0 :                               (list
    3259             :                                "Opening output file"
    3260           0 :                                (format "FTP Error: \"%s\"" (cdr result))
    3261           0 :                                filename)))))
    3262           0 :             (ange-ftp-del-tmp-name temp)
    3263           0 :             (if binary
    3264           0 :                 (ange-ftp-set-ascii-mode host user)))
    3265           0 :           (if (eq visit t)
    3266           0 :               (progn
    3267           0 :                 (set-visited-file-modtime (ange-ftp-file-modtime filename))
    3268           0 :                 (ange-ftp-set-buffer-mode)
    3269           0 :                 (setq buffer-file-name filename)
    3270           0 :                 (set-buffer-modified-p nil)))
    3271             :           ;; ensure `last-coding-system-used' has an appropriate value
    3272           0 :           (setq last-coding-system-used coding-system-used)
    3273           0 :           (ange-ftp-message "Wrote %s" abbr)
    3274           0 :           (ange-ftp-add-file-entry filename))
    3275           0 :       (ange-ftp-real-write-region start end filename append visit))))
    3276             : 
    3277             : (defun ange-ftp-insert-file-contents (filename &optional visit beg end replace)
    3278           0 :   (barf-if-buffer-read-only)
    3279           0 :   (setq filename (expand-file-name filename))
    3280           0 :   (let ((parsed (ange-ftp-ftp-name filename)))
    3281           0 :     (if parsed
    3282           0 :         (progn
    3283           0 :           (if visit
    3284           0 :               (setq buffer-file-name filename))
    3285           0 :           (if (or (file-exists-p filename)
    3286           0 :                   (progn
    3287           0 :                     (setq ange-ftp-ls-cache-file nil)
    3288           0 :                     (remhash (file-name-directory filename)
    3289           0 :                              ange-ftp-files-hashtable)
    3290           0 :                     (file-exists-p filename)))
    3291           0 :               (let* ((host (nth 0 parsed))
    3292           0 :                      (user (nth 1 parsed))
    3293           0 :                      (name (ange-ftp-quote-string (nth 2 parsed)))
    3294           0 :                      (temp (ange-ftp-make-tmp-name host))
    3295           0 :                      (binary (ange-ftp-binary-file filename))
    3296           0 :                      (abbr (ange-ftp-abbreviate-filename filename))
    3297           0 :                      (coding-system-used last-coding-system-used)
    3298             :                      size)
    3299           0 :                 (unwind-protect
    3300           0 :                     (progn
    3301           0 :                       (if binary
    3302           0 :                           (ange-ftp-set-binary-mode host user))
    3303           0 :                       (let ((result (ange-ftp-send-cmd host user
    3304           0 :                                               (list 'get name temp)
    3305           0 :                                               (format "Retrieving %s" abbr))))
    3306           0 :                         (or (car result)
    3307           0 :                             (signal 'ftp-error
    3308           0 :                                     (list
    3309             :                                      "Opening input file"
    3310           0 :                                      (format "FTP Error: \"%s\"" (cdr result))
    3311           0 :                                      filename))))
    3312           0 :                       (if (or (ange-ftp-real-file-readable-p temp)
    3313           0 :                               (sleep-for ange-ftp-retry-time)
    3314             :                               ;; Wait for file to hopefully appear.
    3315           0 :                               (ange-ftp-real-file-readable-p temp))
    3316           0 :                           (setq
    3317             :                            size
    3318           0 :                            (nth 1 (ange-ftp-real-insert-file-contents
    3319           0 :                                    temp visit beg end replace))
    3320           0 :                            coding-system-used last-coding-system-used)
    3321           0 :                         (signal 'ftp-error
    3322           0 :                                 (list
    3323             :                                  "Opening input file:"
    3324           0 :                                  (format
    3325             :                                   "FTP Error: %s not arrived or readable"
    3326           0 :                                   filename)))))
    3327           0 :                   (if binary
    3328             :                       ;; We must keep `last-coding-system-used'
    3329             :                       ;; unchanged.
    3330           0 :                       (let (last-coding-system-used)
    3331           0 :                         (ange-ftp-set-ascii-mode host user)))
    3332           0 :                   (ange-ftp-del-tmp-name temp))
    3333           0 :                 (if visit
    3334           0 :                     (progn
    3335           0 :                       (set-visited-file-modtime
    3336           0 :                        (ange-ftp-file-modtime filename))
    3337           0 :                       (setq buffer-file-name filename)))
    3338           0 :                 (setq last-coding-system-used coding-system-used)
    3339           0 :                 (list filename size))
    3340           0 :             (signal 'file-missing
    3341           0 :                     (list
    3342             :                      "Opening input file"
    3343             :                      "No such file or directory"
    3344           0 :                      filename))))
    3345           0 :       (ange-ftp-real-insert-file-contents filename visit beg end replace))))
    3346             : 
    3347             : (defun ange-ftp-expand-symlink (file dir)
    3348           0 :   (let ((res (if (file-name-absolute-p file)
    3349           0 :                  (ange-ftp-replace-name-component dir file)
    3350           0 :                (expand-file-name file dir))))
    3351           0 :     (if (file-symlink-p res)
    3352           0 :         (ange-ftp-expand-symlink
    3353           0 :          (ange-ftp-get-file-entry res)
    3354           0 :          (file-name-directory (directory-file-name res)))
    3355           0 :       res)))
    3356             : 
    3357             : (defun ange-ftp-file-symlink-p (file)
    3358             :   ;; call ange-ftp-expand-file-name rather than the normal
    3359             :   ;; expand-file-name to stop loops when using a package that
    3360             :   ;; redefines both file-symlink-p and expand-file-name.
    3361           0 :   (setq file (ange-ftp-expand-file-name file))
    3362           0 :   (if (ange-ftp-ftp-name file)
    3363           0 :       (condition-case nil
    3364           0 :           (let ((ent (ange-ftp-get-files (file-name-directory file))))
    3365           0 :             (and ent
    3366           0 :                  (stringp (setq ent
    3367           0 :                                 (gethash (ange-ftp-get-file-part file) ent)))
    3368           0 :                  ent))
    3369             :         ;; If we can't read the parent directory, just assume
    3370             :         ;; this file is not a symlink.
    3371             :         ;; This makes it possible to access a directory that
    3372             :         ;; whose parent is not readable.
    3373           0 :         (file-error nil))
    3374           0 :     (ange-ftp-real-file-symlink-p file)))
    3375             : 
    3376             : (defun ange-ftp-file-exists-p (name)
    3377           0 :   (setq name (expand-file-name name))
    3378           0 :   (if (ange-ftp-ftp-name name)
    3379           0 :       (if (ange-ftp-file-entry-p name)
    3380           0 :           (let ((file-ent (ange-ftp-get-file-entry name)))
    3381           0 :             (if (stringp file-ent)
    3382           0 :                 (ange-ftp-file-exists-p
    3383           0 :                  (ange-ftp-expand-symlink file-ent
    3384           0 :                                           (file-name-directory
    3385           0 :                                            (directory-file-name name))))
    3386           0 :               t)))
    3387           0 :     (ange-ftp-real-file-exists-p name)))
    3388             : 
    3389             : (defun ange-ftp-file-directory-p (name)
    3390           0 :   (setq name (expand-file-name name))
    3391           0 :   (if (ange-ftp-ftp-name name)
    3392             :       ;; We do a file-name-as-directory on name here because some
    3393             :       ;; machines (VMS) use a .DIR to indicate the filename associated
    3394             :       ;; with a directory. This needs to be canonicalized.
    3395           0 :       (let ((file-ent (ange-ftp-get-file-entry
    3396           0 :                        (ange-ftp-file-name-as-directory name))))
    3397           0 :         (if (stringp file-ent)
    3398             :             ;; Calling file-directory-p doesn't work because ange-ftp
    3399             :             ;; is temporarily disabled for this operation.
    3400           0 :             (ange-ftp-file-directory-p
    3401           0 :              (ange-ftp-expand-symlink file-ent
    3402           0 :                                       (file-name-directory
    3403           0 :                                        (directory-file-name name))))
    3404           0 :           file-ent))
    3405           0 :     (ange-ftp-real-file-directory-p name)))
    3406             : 
    3407             : (defun ange-ftp-directory-files (directory &optional full match
    3408             :                                            &rest v19-args)
    3409           0 :   (setq directory (expand-file-name directory))
    3410           0 :   (if (ange-ftp-ftp-name directory)
    3411           0 :       (progn
    3412           0 :         (ange-ftp-barf-if-not-directory directory)
    3413           0 :         (let ((tail (ange-ftp-hash-table-keys
    3414           0 :                      (ange-ftp-get-files directory)))
    3415             :               files f)
    3416           0 :           (setq directory (file-name-as-directory directory))
    3417           0 :           (while tail
    3418           0 :             (setq f (car tail)
    3419           0 :                   tail (cdr tail))
    3420           0 :             (if (or (not match) (string-match-p match f))
    3421           0 :                 (setq files
    3422           0 :                       (cons (if full (concat directory f) f) files))))
    3423           0 :           (nreverse files)))
    3424           0 :     (apply 'ange-ftp-real-directory-files directory full match v19-args)))
    3425             : 
    3426             : (defun ange-ftp-directory-files-and-attributes
    3427             :   (directory &optional full match nosort id-format)
    3428           0 :   (setq directory (expand-file-name directory))
    3429           0 :   (if (ange-ftp-ftp-name directory)
    3430           0 :       (mapcar
    3431             :        (lambda (file)
    3432           0 :          (cons file (file-attributes (expand-file-name file directory))))
    3433           0 :        (ange-ftp-directory-files directory full match nosort))
    3434           0 :     (ange-ftp-real-directory-files-and-attributes
    3435           0 :      directory full match nosort id-format)))
    3436             : 
    3437             : (defun ange-ftp-file-attributes (file &optional id-format)
    3438           0 :   (setq file (expand-file-name file))
    3439           0 :   (let ((parsed (ange-ftp-ftp-name file)))
    3440           0 :     (if parsed
    3441           0 :         (let ((part (ange-ftp-get-file-part file))
    3442           0 :               (files (ange-ftp-get-files (file-name-directory file))))
    3443           0 :           (if (ange-ftp-hash-entry-exists-p part files)
    3444           0 :               (let ((host (nth 0 parsed))
    3445           0 :                     (user (nth 1 parsed))
    3446           0 :                     (name (nth 2 parsed))
    3447           0 :                     (dirp (gethash part files))
    3448           0 :                     (inode (gethash file ange-ftp-inodes-hashtable)))
    3449           0 :                 (unless inode
    3450           0 :                   (setq inode ange-ftp-next-inode-number
    3451           0 :                         ange-ftp-next-inode-number (1+ inode))
    3452           0 :                   (puthash file inode ange-ftp-inodes-hashtable))
    3453           0 :                 (list (if (and (stringp dirp) (file-name-absolute-p dirp))
    3454           0 :                           (ange-ftp-expand-symlink dirp
    3455           0 :                                                    (file-name-directory file))
    3456           0 :                         dirp)           ;0 file type
    3457             :                       -1                ;1 link count
    3458             :                       -1                ;2 uid
    3459             :                       -1                ;3 gid
    3460             :                       '(0 0)            ;4 atime
    3461           0 :                       (ange-ftp-file-modtime file) ;5 mtime
    3462             :                       '(0 0)            ;6 ctime
    3463           0 :                       (ange-ftp-file-size file) ;7 size
    3464           0 :                       (concat (if (stringp dirp) "l" (if dirp "d" "-"))
    3465           0 :                               "?????????") ;8 mode
    3466             :                       nil               ;9 gid weird
    3467           0 :                       inode             ;10 "inode number".
    3468             :                       -1                ;11 device number [v19 only]
    3469           0 :                       ))))
    3470           0 :       (if id-format
    3471           0 :           (ange-ftp-real-file-attributes file id-format)
    3472           0 :         (ange-ftp-real-file-attributes file)))))
    3473             : 
    3474             : (defun ange-ftp-file-newer-than-file-p (f1 f2)
    3475           0 :   (let ((f1-parsed (ange-ftp-ftp-name f1))
    3476           0 :         (f2-parsed (ange-ftp-ftp-name f2)))
    3477           0 :     (if (or f1-parsed f2-parsed)
    3478           0 :         (let ((f1-mt (nth 5 (file-attributes f1)))
    3479           0 :               (f2-mt (nth 5 (file-attributes f2))))
    3480           0 :           (cond ((null f1-mt) nil)
    3481           0 :                 ((null f2-mt) t)
    3482           0 :                 (t (> (float-time f1-mt) (float-time f2-mt)))))
    3483           0 :       (ange-ftp-real-file-newer-than-file-p f1 f2))))
    3484             : 
    3485             : (defun ange-ftp-file-writable-p (file)
    3486           0 :   (let ((ange-ftp-process-verbose nil))
    3487           0 :     (setq file (expand-file-name file))
    3488           0 :     (if (ange-ftp-ftp-name file)
    3489           0 :         (or (file-exists-p file)        ;guess here for speed
    3490           0 :             (file-directory-p (file-name-directory file)))
    3491           0 :       (ange-ftp-real-file-writable-p file))))
    3492             : 
    3493             : (defun ange-ftp-file-readable-p (file)
    3494           0 :   (let ((ange-ftp-process-verbose nil))
    3495           0 :     (setq file (expand-file-name file))
    3496           0 :     (if (ange-ftp-ftp-name file)
    3497           0 :         (file-exists-p file)
    3498           0 :       (ange-ftp-real-file-readable-p file))))
    3499             : 
    3500             : (defun ange-ftp-file-executable-p (file)
    3501           0 :   (let ((ange-ftp-process-verbose nil))
    3502           0 :     (setq file (expand-file-name file))
    3503           0 :     (if (ange-ftp-ftp-name file)
    3504           0 :         (file-exists-p file)
    3505           0 :       (ange-ftp-real-file-executable-p file))))
    3506             : 
    3507             : (defun ange-ftp-delete-file (file &optional trash)
    3508           0 :   (interactive (list (read-file-name "Delete file: " nil default-directory)
    3509           0 :                      (null current-prefix-arg)))
    3510           0 :   (setq file (expand-file-name file))
    3511           0 :   (let ((parsed (ange-ftp-ftp-name file)))
    3512           0 :     (if parsed
    3513           0 :         (let* ((host (nth 0 parsed))
    3514           0 :                (user (nth 1 parsed))
    3515           0 :                (name (ange-ftp-quote-string (nth 2 parsed)))
    3516           0 :                (abbr (ange-ftp-abbreviate-filename file))
    3517           0 :                (result (ange-ftp-send-cmd host user
    3518           0 :                                           (list 'delete name)
    3519           0 :                                           (format "Deleting %s" abbr))))
    3520           0 :           (or (car result)
    3521           0 :               (signal 'ftp-error
    3522           0 :                       (list
    3523             :                        "Removing old name"
    3524           0 :                        (format "FTP Error: \"%s\"" (cdr result))
    3525           0 :                        file)))
    3526           0 :           (ange-ftp-delete-file-entry file))
    3527           0 :       (ange-ftp-real-delete-file file trash))))
    3528             : 
    3529             : (defun ange-ftp-file-modtime (file)
    3530             :   "Return the modification time of remote file FILE.
    3531             : Value is (0 0) if the modification time cannot be determined."
    3532           0 :   (let* ((parsed (ange-ftp-ftp-name file))
    3533             :          ;; At least one FTP server (wu-ftpd) can return a "226
    3534             :          ;; Transfer complete" before the "213 MODTIME".  Let's skip
    3535             :          ;; that.
    3536           0 :          (ange-ftp-skip-msgs (concat ange-ftp-skip-msgs "\\|^226"))
    3537           0 :          (res (ange-ftp-send-cmd (car parsed) (cadr parsed)
    3538           0 :                                  (list 'quote "mdtm" (cadr (cdr parsed)))))
    3539           0 :          (line (cdr res))
    3540             :          (modtime '(0 0)))
    3541             :     ;; MDTM should return "213 YYYYMMDDhhmmss" GMT on success
    3542             :     ;; following the Internet draft for FTP extensions.
    3543             :     ;; Bob@rattlesnake.com reports that is returns something different
    3544             :     ;; for at least one FTP server.  So, let's use the response only
    3545             :     ;; if it matches the Internet draft.
    3546           0 :     (when (string-match-p "^213 [0-9]\\{14\\}$" line)
    3547           0 :       (setq modtime
    3548           0 :             (encode-time
    3549           0 :              (string-to-number (substring line 16 18))
    3550           0 :              (string-to-number (substring line 14 16))
    3551           0 :              (string-to-number (substring line 12 14))
    3552           0 :              (string-to-number (substring line 10 12))
    3553           0 :              (string-to-number (substring line  8 10))
    3554           0 :              (string-to-number (substring line  4  8))
    3555           0 :              0)))
    3556           0 :     modtime))
    3557             : 
    3558             : (defun ange-ftp-verify-visited-file-modtime (buf)
    3559           0 :   (let ((name (buffer-file-name buf)))
    3560           0 :     (if (and (stringp name) (ange-ftp-ftp-name name))
    3561           0 :         (let ((file-mdtm (ange-ftp-file-modtime name))
    3562           0 :               (buf-mdtm (with-current-buffer buf (visited-file-modtime))))
    3563           0 :           (or (zerop (car file-mdtm))
    3564           0 :               (<= (float-time file-mdtm) (float-time buf-mdtm))))
    3565           0 :       (ange-ftp-real-verify-visited-file-modtime buf))))
    3566             : 
    3567             : (defun ange-ftp-file-size (file &optional ascii-mode)
    3568             :   "Return the size of remote file FILE. Return -1 if can't get it.
    3569             : If ascii-mode is non-nil, return the size with the extra octets that
    3570             : need to be inserted, one at the end of each line, to provide correct
    3571             : end-of-line semantics for a transfer using TYPE=A. The default is nil,
    3572             : so return the size on the remote host exactly. See RFC 3659."
    3573           0 :   (let* ((parsed (ange-ftp-ftp-name file))
    3574           0 :          (host (nth 0 parsed))
    3575           0 :          (user (nth 1 parsed))
    3576           0 :          (name (ange-ftp-quote-string (nth 2 parsed)))
    3577             :          ;; At least one FTP server (wu-ftpd) can return a "226
    3578             :          ;; Transfer complete" before the "213 SIZE".  Let's skip
    3579             :          ;; that.
    3580           0 :          (ange-ftp-skip-msgs (concat ange-ftp-skip-msgs "\\|^226"))
    3581           0 :          (res (unwind-protect
    3582           0 :                   (progn
    3583           0 :                     (unless ascii-mode
    3584           0 :                       (ange-ftp-set-binary-mode host user))
    3585           0 :                     (ange-ftp-send-cmd host user (list 'quote "size" name)))
    3586           0 :                 (unless ascii-mode
    3587           0 :                   (ange-ftp-set-ascii-mode host user))))
    3588           0 :          (line (cdr res)))
    3589           0 :     (if (string-match "^213 \\([0-9]+\\)$" line)
    3590           0 :         (string-to-number (match-string 1 line))
    3591           0 :       -1)))
    3592             : 
    3593             : 
    3594             : ;;;; ------------------------------------------------------------
    3595             : ;;;; File copying support... totally re-written 6/24/92.
    3596             : ;;;; ------------------------------------------------------------
    3597             : 
    3598             : (defun ange-ftp-barf-or-query-if-file-exists (absname querystring interactive)
    3599           0 :   (if (file-exists-p absname)
    3600           0 :       (if (not interactive)
    3601           0 :           (signal 'file-already-exists (list absname))
    3602           0 :         (if (not (yes-or-no-p (format "File %s already exists; %s anyway? "
    3603           0 :                                       absname querystring)))
    3604           0 :             (signal 'file-already-exists (list absname))))))
    3605             : 
    3606             : ;; async local copy commented out for now since I don't seem to get
    3607             : ;; the process sentinel called for some processes.
    3608             : ;;
    3609             : ;; (defun ange-ftp-copy-file-locally (filename newname ok-if-already-exists
    3610             : ;;                                          keep-date cont)
    3611             : ;;   "Kludge to copy a local file and call a continuation when the copy
    3612             : ;; finishes."
    3613             : ;;   ;; check to see if we can overwrite
    3614             : ;;   (if (or (not ok-if-already-exists)
    3615             : ;;        (numberp ok-if-already-exists))
    3616             : ;;       (ange-ftp-barf-or-query-if-file-exists newname "copy to it"
    3617             : ;;                                           (numberp ok-if-already-exists)))
    3618             : ;;   (let ((proc (start-process " *copy*"
    3619             : ;;                           (generate-new-buffer "*copy*")
    3620             : ;;                           "cp"
    3621             : ;;                           filename
    3622             : ;;                           newname))
    3623             : ;;      res)
    3624             : ;;     (set-process-sentinel proc 'ange-ftp-copy-file-locally-sentinel)
    3625             : ;;     (process-kill-without-query proc)
    3626             : ;;     (with-current-buffer (process-buffer proc)
    3627             : ;;       (set (make-local-variable 'copy-cont) cont))))
    3628             : ;;
    3629             : ;; (defun ange-ftp-copy-file-locally-sentinel (proc status)
    3630             : ;;   (with-current-buffer (process-buffer proc)
    3631             : ;;     (let ((cont copy-cont)
    3632             : ;;        (result (buffer-string)))
    3633             : ;;       (unwind-protect
    3634             : ;;        (if (and (string-equal status "finished\n")
    3635             : ;;                 (zerop (length result)))
    3636             : ;;            (ange-ftp-call-cont cont t nil)
    3637             : ;;          (ange-ftp-call-cont cont
    3638             : ;;                              nil
    3639             : ;;                              (if (zerop (length result))
    3640             : ;;                                  (substring status 0 -1)
    3641             : ;;                                (substring result 0 -1))))
    3642             : ;;      (kill-buffer (current-buffer))))))
    3643             : 
    3644             : ;; this is the extended version of ange-ftp-copy-file-internal that works
    3645             : ;; asynchronously if asked nicely.
    3646             : (defun ange-ftp-copy-file-internal (filename newname ok-if-already-exists
    3647             :                                              keep-date &optional msg cont nowait)
    3648           0 :   (setq filename (expand-file-name filename)
    3649           0 :         newname (expand-file-name newname))
    3650             : 
    3651           0 :   (or (file-exists-p filename)
    3652           0 :       (signal 'file-missing
    3653           0 :               (list "Copy file" "No such file or directory" filename)))
    3654             : 
    3655             :   ;; canonicalize newname if a directory.
    3656           0 :   (if (file-directory-p newname)
    3657           0 :       (setq newname (expand-file-name (file-name-nondirectory filename) newname)))
    3658             : 
    3659           0 :   (let ((f-parsed (ange-ftp-ftp-name filename))
    3660           0 :         (t-parsed (ange-ftp-ftp-name newname)))
    3661             : 
    3662             :     ;; local file to local file copy?
    3663           0 :     (if (and (not f-parsed) (not t-parsed))
    3664           0 :         (progn
    3665           0 :           (ange-ftp-real-copy-file filename newname ok-if-already-exists
    3666           0 :                                    keep-date)
    3667           0 :           (if cont
    3668           0 :               (ange-ftp-call-cont cont t "Copied locally")))
    3669             :       ;; one or both files are remote.
    3670           0 :       (let* ((f-host (and f-parsed (nth 0 f-parsed)))
    3671           0 :              (f-user (and f-parsed (nth 1 f-parsed)))
    3672           0 :              (f-name (and f-parsed (ange-ftp-quote-string (nth 2 f-parsed))))
    3673           0 :              (f-abbr (ange-ftp-abbreviate-filename filename))
    3674           0 :              (t-host (and t-parsed (nth 0 t-parsed)))
    3675           0 :              (t-user (and t-parsed (nth 1 t-parsed)))
    3676           0 :              (t-name (and t-parsed (ange-ftp-quote-string (nth 2 t-parsed))))
    3677           0 :              (t-abbr (ange-ftp-abbreviate-filename newname filename))
    3678           0 :              (binary (or (ange-ftp-binary-file filename)
    3679           0 :                          (ange-ftp-binary-file newname)))
    3680             :              temp1
    3681             :              temp2)
    3682             : 
    3683             :         ;; check to see if we can overwrite
    3684           0 :         (if (or (not ok-if-already-exists)
    3685           0 :                 (numberp ok-if-already-exists))
    3686           0 :             (ange-ftp-barf-or-query-if-file-exists newname "copy to it"
    3687           0 :                                                    (numberp ok-if-already-exists)))
    3688             : 
    3689             :         ;; do the copying.
    3690           0 :         (if f-parsed
    3691             : 
    3692             :             ;; filename was remote.
    3693           0 :             (progn
    3694           0 :               (if (or (ange-ftp-use-gateway-p f-host)
    3695           0 :                       t-parsed)
    3696             :                   ;; have to use intermediate file if we are getting via
    3697             :                   ;; gateway machine or we are doing a remote to remote copy.
    3698           0 :                   (setq temp1 (ange-ftp-make-tmp-name f-host)))
    3699             : 
    3700           0 :               (if binary
    3701           0 :                   (ange-ftp-set-binary-mode f-host f-user))
    3702             : 
    3703           0 :               (ange-ftp-send-cmd
    3704           0 :                f-host
    3705           0 :                f-user
    3706           0 :                (list 'get f-name (or temp1 (ange-ftp-quote-string newname)))
    3707           0 :                (or msg
    3708           0 :                    (if (and temp1 t-parsed)
    3709           0 :                        (format "Getting %s" f-abbr)
    3710           0 :                      (format "Copying %s to %s" f-abbr t-abbr)))
    3711           0 :                (list 'ange-ftp-cf1
    3712           0 :                      filename newname binary msg
    3713           0 :                      f-parsed f-host f-user f-name f-abbr
    3714           0 :                      t-parsed t-host t-user t-name t-abbr
    3715           0 :                      temp1 temp2 cont nowait)
    3716           0 :                nowait))
    3717             : 
    3718             :           ;; filename wasn't remote.  newname must be remote.  call the
    3719             :           ;; function which does the remainder of the copying work.
    3720           0 :           (ange-ftp-cf1 t nil
    3721           0 :                         filename newname binary msg
    3722           0 :                         f-parsed f-host f-user f-name f-abbr
    3723           0 :                         t-parsed t-host t-user t-name t-abbr
    3724           0 :                         nil nil cont nowait))))))
    3725             : 
    3726             : (defvar ange-ftp-waiting-flag nil)
    3727             : 
    3728             : ;; next part of copying routine.
    3729             : (defun ange-ftp-cf1 (result line
    3730             :                             filename newname binary msg
    3731             :                             f-parsed f-host f-user _f-name f-abbr
    3732             :                             t-parsed t-host t-user t-name t-abbr
    3733             :                             temp1 temp2 cont nowait)
    3734           0 :   (if line
    3735             :       ;; filename must have been remote, and we must have just done a GET.
    3736           0 :       (unwind-protect
    3737           0 :           (or result
    3738             :               ;; GET failed for some reason.  Clean up and get out.
    3739           0 :               (progn
    3740           0 :                 (and temp1 (ange-ftp-del-tmp-name temp1))
    3741           0 :                 (or cont
    3742           0 :                     (if ange-ftp-waiting-flag
    3743           0 :                         (throw 'ftp-error t)
    3744           0 :                       (signal 'ftp-error
    3745           0 :                               (list "Opening input file"
    3746           0 :                                     (format "FTP Error: \"%s\"" line)
    3747           0 :                                     filename))))))
    3748             :         ;; cleanup
    3749           0 :         (if binary
    3750           0 :             (ange-ftp-set-ascii-mode f-host f-user))))
    3751             : 
    3752           0 :   (if result
    3753             :       ;; We now have to copy either temp1 or filename to newname.
    3754           0 :       (if t-parsed
    3755             : 
    3756             :           ;; newname was remote.
    3757           0 :           (progn
    3758           0 :             (if (ange-ftp-use-gateway-p t-host)
    3759           0 :                 (setq temp2 (ange-ftp-make-tmp-name t-host)))
    3760             : 
    3761             :             ;; make sure data is moved into the right place for the
    3762             :             ;; outgoing transfer.  gateway temporary files complicate
    3763             :             ;; things nicely.
    3764           0 :             (if temp1
    3765           0 :                 (if temp2
    3766           0 :                     (if (string-equal temp1 temp2)
    3767           0 :                         (setq temp1 nil)
    3768           0 :                       (ange-ftp-real-copy-file temp1 temp2 t))
    3769           0 :                   (setq temp2 temp1 temp1 nil))
    3770           0 :               (if temp2
    3771           0 :                   (ange-ftp-real-copy-file filename temp2 t)))
    3772             : 
    3773           0 :             (if binary
    3774           0 :                 (ange-ftp-set-binary-mode t-host t-user))
    3775             : 
    3776             :             ;; tell the process filter what size the file is.
    3777           0 :             (let ((attr (file-attributes (or temp2 filename))))
    3778           0 :               (if attr
    3779           0 :                   (ange-ftp-set-xfer-size t-host t-user (nth 7 attr))))
    3780             : 
    3781           0 :             (ange-ftp-send-cmd
    3782           0 :              t-host
    3783           0 :              t-user
    3784           0 :              (list 'put (or temp2 (ange-ftp-quote-string filename)) t-name)
    3785           0 :              (or msg
    3786           0 :                  (if (and temp2 f-parsed)
    3787           0 :                      (format "Putting %s" newname)
    3788           0 :                    (format "Copying %s to %s" f-abbr t-abbr)))
    3789           0 :              (list 'ange-ftp-cf2
    3790           0 :                    newname t-host t-user binary temp1 temp2 cont)
    3791           0 :              nowait)
    3792           0 :             (ange-ftp-add-file-entry newname))
    3793             : 
    3794             :         ;; newname wasn't remote.
    3795           0 :         (ange-ftp-cf2 t nil newname t-host t-user binary temp1 temp2 cont))
    3796             : 
    3797             :     ;; first copy failed, tell caller
    3798           0 :     (ange-ftp-call-cont cont result line)))
    3799             : 
    3800             : ;; last part of copying routine.
    3801             : (defun ange-ftp-cf2 (result line newname t-host t-user binary temp1 temp2 cont)
    3802           0 :   (unwind-protect
    3803           0 :       (if line
    3804             :           ;; result from doing a local to remote copy.
    3805           0 :           (unwind-protect
    3806           0 :               (progn
    3807           0 :                 (or result
    3808           0 :                     (or cont
    3809           0 :                         (if ange-ftp-waiting-flag
    3810           0 :                             (throw 'ftp-error t)
    3811           0 :                           (signal 'ftp-error
    3812           0 :                                   (list "Opening output file"
    3813           0 :                                         (format "FTP Error: \"%s\"" line)
    3814           0 :                                         newname)))))
    3815             : 
    3816           0 :                 (ange-ftp-add-file-entry newname))
    3817             : 
    3818             :             ;; cleanup.
    3819           0 :             (if binary
    3820           0 :                 (ange-ftp-set-ascii-mode t-host t-user)))
    3821             : 
    3822             :         ;; newname was local.
    3823           0 :         (if temp1
    3824           0 :             (ange-ftp-real-copy-file temp1 newname t)))
    3825             : 
    3826             :     ;; clean up
    3827           0 :     (and temp1 (ange-ftp-del-tmp-name temp1))
    3828           0 :     (and temp2 (ange-ftp-del-tmp-name temp2))
    3829           0 :     (ange-ftp-call-cont cont result line)))
    3830             : 
    3831             : (defun ange-ftp-copy-file (filename newname &optional ok-if-already-exists
    3832             :                                     keep-date preserve-uid-gid
    3833             :                                     _preserve-selinux-context)
    3834             :   (interactive "fCopy file: \nFCopy %s to file: \np")
    3835           0 :   (ange-ftp-copy-file-internal filename
    3836           0 :                                newname
    3837           0 :                                ok-if-already-exists
    3838           0 :                                keep-date
    3839             :                                nil
    3840             :                                nil
    3841           0 :                                (called-interactively-p 'interactive)))
    3842             : 
    3843             : (defun ange-ftp-copy-files-async (okay-p line verbose-p files)
    3844             :   "Copy some files in the background.
    3845             : OKAY-P must be t, and LINE does not matter.  They are here to make this
    3846             :  function a valid CONT argument for `ange-ftp-raw-send-cmd'.
    3847             : If VERBOSE-P is non-nil, print progress report in the echo area.
    3848             :  When all the files have been copied already, a message is shown anyway.
    3849             : FILES is a list of files to copy in the form
    3850             :   (from-file to-file ok-if-already-exists keep-date)
    3851             : E.g.,
    3852             :   (ange-ftp-copy-files-async t nil t \\='((\"a\" \"b\" t t) (\"c\" \"d\" t t)))"
    3853           0 :   (unless okay-p (error "%s: %s" 'ange-ftp-copy-files-async line))
    3854           0 :   (if files
    3855           0 :       (let* ((ff (car files))
    3856           0 :              (from-file            (nth 0 ff))
    3857           0 :              (to-file              (nth 1 ff))
    3858           0 :              (ok-if-already-exists (nth 2 ff))
    3859           0 :              (keep-date            (nth 3 ff)))
    3860           0 :         (ange-ftp-copy-file-internal
    3861           0 :          from-file to-file ok-if-already-exists keep-date
    3862           0 :          (and verbose-p (format "%s --> %s" from-file to-file))
    3863           0 :          (list 'ange-ftp-copy-files-async verbose-p (cdr files))
    3864           0 :          t))
    3865           0 :     (message "%s: done" 'ange-ftp-copy-files-async)))
    3866             : 
    3867             : 
    3868             : ;;;; ------------------------------------------------------------
    3869             : ;;;; File renaming support.
    3870             : ;;;; ------------------------------------------------------------
    3871             : 
    3872             : (defun ange-ftp-rename-remote-to-remote (filename newname f-parsed t-parsed)
    3873             :   "Rename remote file FILENAME to remote file NEWNAME."
    3874           0 :   (let ((f-host (nth 0 f-parsed))
    3875           0 :         (f-user (nth 1 f-parsed))
    3876           0 :         (t-host (nth 0 t-parsed))
    3877           0 :         (t-user (nth 1 t-parsed)))
    3878           0 :     (if (and (string-equal f-host t-host)
    3879           0 :              (string-equal f-user t-user))
    3880           0 :         (let* ((f-name (ange-ftp-quote-string (nth 2 f-parsed)))
    3881           0 :                (t-name (ange-ftp-quote-string (nth 2 t-parsed)))
    3882           0 :                (cmd (list 'rename f-name t-name))
    3883           0 :                (fabbr (ange-ftp-abbreviate-filename filename))
    3884           0 :                (nabbr (ange-ftp-abbreviate-filename newname filename))
    3885           0 :                (result (ange-ftp-send-cmd f-host f-user cmd
    3886           0 :                                           (format "Renaming %s to %s"
    3887           0 :                                                   fabbr
    3888           0 :                                                   nabbr))))
    3889           0 :           (or (car result)
    3890           0 :               (signal 'ftp-error
    3891           0 :                       (list
    3892             :                        "Renaming"
    3893           0 :                        (format "FTP Error: \"%s\"" (cdr result))
    3894           0 :                        filename
    3895           0 :                        newname)))
    3896           0 :           (ange-ftp-add-file-entry newname)
    3897           0 :           (ange-ftp-delete-file-entry filename))
    3898           0 :       (ange-ftp-copy-file-internal filename newname t nil)
    3899           0 :       (delete-file filename))))
    3900             : 
    3901             : (defun ange-ftp-rename-local-to-remote (filename newname)
    3902             :   "Rename local file FILENAME to remote file NEWNAME."
    3903           0 :   (let* ((fabbr (ange-ftp-abbreviate-filename filename))
    3904           0 :          (nabbr (ange-ftp-abbreviate-filename newname filename))
    3905           0 :          (msg (format "Renaming %s to %s" fabbr nabbr)))
    3906           0 :     (ange-ftp-copy-file-internal filename newname t nil msg)
    3907           0 :     (let (ange-ftp-process-verbose)
    3908           0 :       (delete-file filename))))
    3909             : 
    3910             : (defun ange-ftp-rename-remote-to-local (filename newname)
    3911             :   "Rename remote file FILENAME to local file NEWNAME."
    3912           0 :   (let* ((fabbr (ange-ftp-abbreviate-filename filename))
    3913           0 :          (nabbr (ange-ftp-abbreviate-filename newname filename))
    3914           0 :          (msg (format "Renaming %s to %s" fabbr nabbr)))
    3915           0 :     (ange-ftp-copy-file-internal filename newname t nil msg)
    3916           0 :     (let (ange-ftp-process-verbose)
    3917           0 :       (delete-file filename))))
    3918             : 
    3919             : (defun ange-ftp-rename-file (filename newname &optional ok-if-already-exists)
    3920             :   (interactive "fRename file: \nFRename %s to file: \np")
    3921           0 :   (setq filename (expand-file-name filename))
    3922           0 :   (setq newname (expand-file-name newname))
    3923           0 :   (let* ((f-parsed (ange-ftp-ftp-name filename))
    3924           0 :          (t-parsed (ange-ftp-ftp-name newname)))
    3925           0 :     (if (and (or f-parsed t-parsed)
    3926           0 :              (or (not ok-if-already-exists)
    3927           0 :                  (numberp ok-if-already-exists)))
    3928           0 :         (ange-ftp-barf-or-query-if-file-exists
    3929           0 :          newname
    3930             :          "rename to it"
    3931           0 :          (numberp ok-if-already-exists)))
    3932           0 :     (if f-parsed
    3933           0 :         (if t-parsed
    3934           0 :             (ange-ftp-rename-remote-to-remote filename newname f-parsed
    3935           0 :                                               t-parsed)
    3936           0 :           (ange-ftp-rename-remote-to-local filename newname))
    3937           0 :       (if t-parsed
    3938           0 :           (ange-ftp-rename-local-to-remote filename newname)
    3939           0 :         (ange-ftp-real-rename-file filename newname ok-if-already-exists)))))
    3940             : 
    3941             : ;;;; ------------------------------------------------------------
    3942             : ;;;; File name completion support.
    3943             : ;;;; ------------------------------------------------------------
    3944             : 
    3945             : ;; If the file entry is not a directory (nor a symlink pointing to a directory)
    3946             : ;; returns whether the file (or file pointed to by the symlink) is ignored
    3947             : ;; by completion-ignored-extensions.
    3948             : ;; Note that `ange-ftp-this-dir' and `ange-ftp-completion-ignored-pattern'
    3949             : ;; are used as free variables.
    3950             : (defun ange-ftp-file-entry-not-ignored-p (symname val)
    3951           0 :   (if (stringp val)
    3952           0 :       (let ((file (ange-ftp-expand-symlink val ange-ftp-this-dir)))
    3953           0 :         (or (file-directory-p file)
    3954           0 :             (and (file-exists-p file)
    3955           0 :                  (not (string-match ange-ftp-completion-ignored-pattern
    3956           0 :                                     symname)))))
    3957           0 :     (or val                             ; is a directory name
    3958           0 :         (not (string-match ange-ftp-completion-ignored-pattern symname)))))
    3959             : 
    3960             : (defun ange-ftp-root-dir-p (dir)
    3961             :   ;; Maybe we should use something more like
    3962             :   ;; (equal dir (file-name-directory (directory-file-name dir)))  -stef
    3963           0 :   (or (and (eq system-type 'windows-nt)
    3964           0 :            (string-match "\\`[a-zA-Z]:[/\\]\\'" dir))
    3965           0 :       (string-equal "/" dir)))
    3966             : 
    3967             : (defmacro ange-ftp-ignore-errors-if-non-essential (&rest body)
    3968           1 :   `(if non-essential
    3969           1 :        (ignore-errors ,@body)
    3970           1 :      (progn ,@body)))
    3971             : 
    3972             : (defun ange-ftp-file-name-all-completions (file dir)
    3973           0 :   (let ((ange-ftp-this-dir (expand-file-name dir)))
    3974           0 :     (if (ange-ftp-ftp-name ange-ftp-this-dir)
    3975           0 :         (ange-ftp-ignore-errors-if-non-essential
    3976             :           (ange-ftp-barf-if-not-directory ange-ftp-this-dir)
    3977             :           (setq ange-ftp-this-dir
    3978             :                 (ange-ftp-real-file-name-as-directory ange-ftp-this-dir))
    3979             :           (let* ((tbl (ange-ftp-get-files ange-ftp-this-dir))
    3980             :                  (completions (all-completions file tbl)))
    3981             : 
    3982             :             ;; see whether each matching file is a directory or not...
    3983             :             (mapcar
    3984             :              (lambda (file)
    3985             :                (let ((ent (gethash file tbl)))
    3986             :                  (if (and ent
    3987             :                           (or (not (stringp ent))
    3988             :                               (file-directory-p
    3989             :                                (ange-ftp-expand-symlink ent
    3990             :                                                         ange-ftp-this-dir))))
    3991             :                      (concat file "/")
    3992             :                    file)))
    3993           0 :              completions)))
    3994             : 
    3995           0 :       (if (ange-ftp-root-dir-p ange-ftp-this-dir)
    3996           0 :           (nconc (all-completions file (ange-ftp-generate-root-prefixes))
    3997           0 :                  (ange-ftp-real-file-name-all-completions file
    3998           0 :                                                           ange-ftp-this-dir))
    3999           0 :         (ange-ftp-real-file-name-all-completions file ange-ftp-this-dir)))))
    4000             : 
    4001             : (defun ange-ftp-file-name-completion (file dir &optional predicate)
    4002           0 :   (let ((ange-ftp-this-dir (expand-file-name dir)))
    4003           0 :     (if (ange-ftp-ftp-name ange-ftp-this-dir)
    4004           0 :         (progn
    4005           0 :           (ange-ftp-barf-if-not-directory ange-ftp-this-dir)
    4006           0 :           (if (equal file "")
    4007             :               ""
    4008           0 :             (setq ange-ftp-this-dir
    4009           0 :                   (ange-ftp-real-file-name-as-directory ange-ftp-this-dir))     ;real?
    4010           0 :             (let* ((tbl (ange-ftp-get-files ange-ftp-this-dir))
    4011             :                    (ange-ftp-completion-ignored-pattern
    4012           0 :                     (mapconcat (lambda (s) (if (stringp s)
    4013           0 :                                           (concat (regexp-quote s) "$")
    4014           0 :                                         "/")) ; / never in filename
    4015           0 :                                completion-ignored-extensions
    4016           0 :                                "\\|")))
    4017           0 :               (save-match-data
    4018           0 :                 (or (ange-ftp-file-name-completion-1
    4019           0 :                      file tbl ange-ftp-this-dir
    4020           0 :                      'ange-ftp-file-entry-not-ignored-p)
    4021           0 :                     (ange-ftp-file-name-completion-1
    4022           0 :                      file tbl ange-ftp-this-dir))))))
    4023             : 
    4024           0 :       (if (ange-ftp-root-dir-p ange-ftp-this-dir)
    4025           0 :           (try-completion
    4026           0 :            file
    4027           0 :            (nconc (ange-ftp-generate-root-prefixes)
    4028           0 :                   (ange-ftp-real-file-name-all-completions
    4029           0 :                    file ange-ftp-this-dir))
    4030           0 :            predicate)
    4031           0 :         (if predicate
    4032           0 :             (ange-ftp-real-file-name-completion
    4033           0 :              file ange-ftp-this-dir predicate)
    4034           0 :           (ange-ftp-real-file-name-completion
    4035           0 :            file ange-ftp-this-dir))))))
    4036             : 
    4037             : 
    4038             : (defun ange-ftp-file-name-completion-1 (file tbl dir &optional predicate)
    4039           0 :   (let ((bestmatch (try-completion file tbl predicate)))
    4040           0 :     (if bestmatch
    4041           0 :         (if (eq bestmatch t)
    4042           0 :             (if (file-directory-p (expand-file-name file dir))
    4043           0 :                 (concat file "/")
    4044           0 :               t)
    4045           0 :           (if (and (eq (try-completion bestmatch tbl predicate) t)
    4046           0 :                    (file-directory-p
    4047           0 :                     (expand-file-name bestmatch dir)))
    4048           0 :               (concat bestmatch "/")
    4049           0 :             bestmatch)))))
    4050             : 
    4051             : ;; Put these lines uncommented in your .emacs if you want C-r to refresh
    4052             : ;; ange-ftp's cache whilst doing filename completion.
    4053             : ;;
    4054             : ;;(define-key minibuffer-local-completion-map "\C-r" 'ange-ftp-re-read-dir)
    4055             : ;;(define-key minibuffer-local-must-match-map "\C-r" 'ange-ftp-re-read-dir)
    4056             : 
    4057             : ;;;###autoload
    4058             : (defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir)
    4059             : 
    4060             : ;;;###autoload
    4061             : (defun ange-ftp-reread-dir (&optional dir)
    4062             :   "Reread remote directory DIR to update the directory cache.
    4063             : The implementation of remote FTP file names caches directory contents
    4064             : for speed.  Therefore, when new remote files are created, Emacs
    4065             : may not know they exist.  You can use this command to reread a specific
    4066             : directory, so that Emacs will know its current contents."
    4067             :   (interactive)
    4068           0 :   (if dir
    4069           0 :       (setq dir (expand-file-name dir))
    4070           0 :     (setq dir (file-name-directory (expand-file-name (buffer-string)))))
    4071           0 :   (if (ange-ftp-ftp-name dir)
    4072           0 :       (progn
    4073           0 :         (setq ange-ftp-ls-cache-file nil)
    4074           0 :         (remhash dir ange-ftp-files-hashtable)
    4075           0 :         (ange-ftp-get-files dir t))))
    4076             : 
    4077             : (defun ange-ftp-make-directory (dir &optional parents)
    4078           0 :   (interactive (list (expand-file-name (read-directory-name "Make directory: "))))
    4079           0 :   (if parents
    4080           0 :       (let ((parent (file-name-directory (directory-file-name dir))))
    4081           0 :         (or (file-exists-p parent)
    4082           0 :             (ange-ftp-make-directory parent parents))))
    4083           0 :   (if (file-exists-p dir)
    4084           0 :       (unless parents
    4085           0 :         (error "Cannot make directory %s: file already exists" dir))
    4086           0 :     (let ((parsed (ange-ftp-ftp-name dir)))
    4087           0 :       (if parsed
    4088           0 :           (let* ((host (nth 0 parsed))
    4089           0 :                  (user (nth 1 parsed))
    4090             :                  ;; Some ftp's on unix machines (at least on Suns)
    4091             :                  ;; insist that mkdir take a filename, and not a
    4092             :                  ;; directory-name name as an arg. Argh!! This is a bug.
    4093             :                  ;; Non-unix machines will probably always insist
    4094             :                  ;; that mkdir takes a directory-name as an arg
    4095             :                  ;; (as the ftp man page says it should).
    4096           0 :                  (name (ange-ftp-quote-string
    4097           0 :                         (if (eq (ange-ftp-host-type host) 'unix)
    4098           0 :                             (ange-ftp-real-directory-file-name (nth 2 parsed))
    4099           0 :                           (ange-ftp-real-file-name-as-directory
    4100           0 :                            (nth 2 parsed)))))
    4101           0 :                  (abbr (ange-ftp-abbreviate-filename dir))
    4102           0 :                  (result (ange-ftp-send-cmd host user
    4103           0 :                                             (list 'mkdir name)
    4104           0 :                                             (format "Making directory %s"
    4105           0 :                                                     abbr))))
    4106           0 :             (or (car result)
    4107           0 :                 (ange-ftp-error host user
    4108           0 :                                 (format "Could not make directory %s: %s"
    4109           0 :                                         dir
    4110           0 :                                         (cdr result))))
    4111           0 :             (ange-ftp-add-file-entry dir t))
    4112           0 :         (ange-ftp-real-make-directory dir)))))
    4113             : 
    4114             : (defun ange-ftp-delete-directory (dir &optional recursive trash)
    4115           0 :   (if (file-directory-p dir)
    4116           0 :       (let ((parsed (ange-ftp-ftp-name dir)))
    4117           0 :         (if recursive
    4118           0 :             (mapc
    4119             :              (lambda (file)
    4120           0 :                (if (file-directory-p file)
    4121           0 :                    (ange-ftp-delete-directory file recursive trash)
    4122           0 :                  (delete-file file trash)))
    4123             :              ;; We do not want to delete "." and "..".
    4124           0 :              (directory-files
    4125           0 :               dir 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
    4126           0 :         (if parsed
    4127           0 :             (let* ((host (nth 0 parsed))
    4128           0 :                    (user (nth 1 parsed))
    4129             :                    ;; Some ftp's on unix machines (at least on Suns)
    4130             :                    ;; insist that rmdir take a filename, and not a
    4131             :                    ;; directory-name name as an arg. Argh!! This is a bug.
    4132             :                    ;; Non-unix machines will probably always insist
    4133             :                    ;; that rmdir takes a directory-name as an arg
    4134             :                    ;; (as the ftp man page says it should).
    4135           0 :                    (name (ange-ftp-quote-string
    4136           0 :                           (if (eq (ange-ftp-host-type host) 'unix)
    4137           0 :                               (ange-ftp-real-directory-file-name
    4138           0 :                                (nth 2 parsed))
    4139           0 :                             (ange-ftp-real-file-name-as-directory
    4140           0 :                              (nth 2 parsed)))))
    4141           0 :                    (abbr (ange-ftp-abbreviate-filename dir))
    4142             :                    (result
    4143           0 :                     (progn
    4144             :                       ;; CWD must not in this directory.
    4145           0 :                       (ange-ftp-cd host user "/" 'noerror)
    4146           0 :                       (ange-ftp-send-cmd host user
    4147           0 :                                          (list 'rmdir name)
    4148           0 :                                          (format "Removing directory %s"
    4149           0 :                                                  abbr)))))
    4150           0 :               (or (car result)
    4151           0 :                   (ange-ftp-error host user
    4152           0 :                                   (format "Could not remove directory %s: %s"
    4153           0 :                                           dir
    4154           0 :                                           (cdr result))))
    4155           0 :               (ange-ftp-delete-file-entry dir t))
    4156           0 :           (ange-ftp-real-delete-directory dir recursive trash)))
    4157           0 :     (error "Not a directory: %s" dir)))
    4158             : 
    4159             : ;; Make a local copy of FILE and return its name.
    4160             : 
    4161             : (defun ange-ftp-file-local-copy (file)
    4162           0 :   (let* ((fn1 (expand-file-name file))
    4163           0 :          (pa1 (ange-ftp-ftp-name fn1)))
    4164           0 :     (if pa1
    4165           0 :         (let ((tmp1 (ange-ftp-make-tmp-name (car pa1)
    4166           0 :                                             (file-name-extension file t))))
    4167           0 :           (ange-ftp-copy-file-internal fn1 tmp1 t nil
    4168           0 :                                        (format "Getting %s" fn1))
    4169           0 :           tmp1))))
    4170             : 
    4171             : (defun ange-ftp-file-remote-p (file &optional identification connected)
    4172           3 :   (let* ((parsed (ange-ftp-ftp-name file))
    4173           3 :          (host (nth 0 parsed))
    4174           3 :          (user (nth 1 parsed))
    4175           3 :          (localname (nth 2 parsed)))
    4176           3 :     (and (or (not connected)
    4177           0 :              (let ((proc (get-process (ange-ftp-ftp-process-buffer host user))))
    4178           0 :                (and proc (processp proc)
    4179           3 :                     (memq (process-status proc) '(run open)))))
    4180           3 :          (cond
    4181           3 :           ((eq identification 'method) (and parsed "ftp"))
    4182           0 :           ((eq identification 'user) user)
    4183           0 :           ((eq identification 'host) host)
    4184           0 :           ((eq identification 'localname) localname)
    4185           3 :           (t (ange-ftp-replace-name-component file ""))))))
    4186             : 
    4187             : (defun ange-ftp-load (file &optional noerror nomessage nosuffix)
    4188           0 :   (if (ange-ftp-ftp-name file)
    4189           0 :       (let ((tryfiles (if nosuffix
    4190           0 :                           (list file)
    4191           0 :                         (list (concat file ".elc") (concat file ".el") file)))
    4192             :             ;; make sure there are no references to temp files
    4193             :             (load-force-doc-strings t)
    4194             :             copy)
    4195           0 :         (while (and tryfiles (not copy))
    4196           0 :           (catch 'ftp-error
    4197           0 :             (let ((ange-ftp-waiting-flag t))
    4198           0 :               (condition-case _error
    4199           0 :                   (setq copy (ange-ftp-file-local-copy (car tryfiles)))
    4200           0 :                 (ftp-error nil))))
    4201           0 :           (setq tryfiles (cdr tryfiles)))
    4202           0 :         (if copy
    4203           0 :             (unwind-protect
    4204           0 :                 (funcall 'load copy noerror nomessage nosuffix)
    4205           0 :               (delete-file copy))
    4206           0 :           (or noerror
    4207           0 :               (signal 'file-error (list "Cannot open load file" file)))
    4208           0 :           nil))
    4209           0 :     (ange-ftp-real-load file noerror nomessage nosuffix)))
    4210             : 
    4211             : ;; Calculate default-unhandled-directory for a given ange-ftp buffer.
    4212             : (defun ange-ftp-unhandled-file-name-directory (_filename)
    4213             :   nil)
    4214             : 
    4215             : 
    4216             : ;; Need the following functions for making filenames of compressed
    4217             : ;; files, because some OS's (unlike UNIX) do not allow a filename to
    4218             : ;; have two extensions.
    4219             : 
    4220             : (defvar ange-ftp-make-compressed-filename-alist nil
    4221             :   "Alist of host-type-specific functions to process file names for compression.
    4222             : Each element has the form (TYPE . FUNC).
    4223             : FUNC should take one argument, a file name, and return a list
    4224             : of the form (COMPRESSING NEWNAME).
    4225             : COMPRESSING should be t if the specified file should be compressed,
    4226             : and nil if it should be uncompressed (that is, if it is a compressed file).
    4227             : NEWNAME should be the name to give the new compressed or uncompressed file.")
    4228             : 
    4229             : (declare-function dired-compress-file "dired-aux" (file))
    4230             : 
    4231             : (defun ange-ftp-dired-compress-file (name)
    4232             :   "Handler used by `dired-compress-file'."
    4233           0 :   (let ((parsed (ange-ftp-ftp-name name))
    4234             :         conversion-func)
    4235           0 :     (if (and parsed
    4236           0 :              (setq conversion-func
    4237           0 :                    (cdr (assq (ange-ftp-host-type (car parsed))
    4238           0 :                               ange-ftp-make-compressed-filename-alist))))
    4239           0 :         (let* ((decision
    4240           0 :                 (save-match-data (funcall conversion-func name)))
    4241           0 :                (compressing (car decision))
    4242           0 :                (newfile (nth 1 decision)))
    4243           0 :           (if compressing
    4244           0 :               (ange-ftp-compress name newfile)
    4245           0 :             (ange-ftp-uncompress name newfile)))
    4246           0 :       (let (file-name-handler-alist)
    4247           0 :         (dired-compress-file name)))))
    4248             : 
    4249             : ;; Copy FILE to this machine, compress it, and copy out to NFILE.
    4250             : (defun ange-ftp-compress (file nfile)
    4251           0 :   (let* ((parsed (ange-ftp-ftp-name file))
    4252           0 :          (tmp1 (ange-ftp-make-tmp-name (car parsed)))
    4253           0 :          (tmp2 (ange-ftp-make-tmp-name (car parsed)))
    4254           0 :          (abbr (ange-ftp-abbreviate-filename file))
    4255           0 :          (nabbr (ange-ftp-abbreviate-filename nfile))
    4256           0 :          (msg1 (format "Getting %s" abbr))
    4257           0 :          (msg2 (format "Putting %s" nabbr)))
    4258           0 :     (unwind-protect
    4259           0 :         (progn
    4260           0 :           (ange-ftp-copy-file-internal file tmp1 t nil msg1)
    4261           0 :           (and ange-ftp-process-verbose
    4262           0 :                (ange-ftp-message "Compressing %s..." abbr))
    4263           0 :           (call-process-region (point)
    4264           0 :                                (point)
    4265           0 :                                shell-file-name
    4266             :                                nil
    4267             :                                t
    4268             :                                nil
    4269             :                                "-c"
    4270           0 :                                (format "compress -f -c < %s > %s" tmp1 tmp2))
    4271           0 :           (and ange-ftp-process-verbose
    4272           0 :                (ange-ftp-message "Compressing %s...done" abbr))
    4273           0 :           (if (zerop (buffer-size))
    4274           0 :               (progn
    4275           0 :                 (let (ange-ftp-process-verbose)
    4276           0 :                   (delete-file file))
    4277           0 :                 (ange-ftp-copy-file-internal tmp2 nfile t nil msg2))))
    4278           0 :       (ange-ftp-del-tmp-name tmp1)
    4279           0 :       (ange-ftp-del-tmp-name tmp2))))
    4280             : 
    4281             : ;; Copy FILE to this machine, uncompress it, and copy out to NFILE.
    4282             : (defun ange-ftp-uncompress (file nfile)
    4283           0 :   (let* ((parsed (ange-ftp-ftp-name file))
    4284           0 :          (tmp1 (ange-ftp-make-tmp-name (car parsed)))
    4285           0 :          (tmp2 (ange-ftp-make-tmp-name (car parsed)))
    4286           0 :          (abbr (ange-ftp-abbreviate-filename file))
    4287           0 :          (nabbr (ange-ftp-abbreviate-filename nfile))
    4288           0 :          (msg1 (format "Getting %s" abbr))
    4289           0 :          (msg2 (format "Putting %s" nabbr))
    4290             : ;;       ;; Cheap hack because of problems with binary file transfers from
    4291             : ;;       ;; VMS hosts.
    4292             : ;;       (gbinary (not (eq 'vms (ange-ftp-host-type (car parsed)))))
    4293             :          )
    4294           0 :     (unwind-protect
    4295           0 :         (progn
    4296           0 :           (ange-ftp-copy-file-internal file tmp1 t nil msg1)
    4297           0 :           (and ange-ftp-process-verbose
    4298           0 :                (ange-ftp-message "Uncompressing %s..." abbr))
    4299           0 :           (call-process-region (point)
    4300           0 :                                (point)
    4301           0 :                                shell-file-name
    4302             :                                nil
    4303             :                                t
    4304             :                                nil
    4305             :                                "-c"
    4306           0 :                                (format "uncompress -c < %s > %s" tmp1 tmp2))
    4307           0 :           (and ange-ftp-process-verbose
    4308           0 :                (ange-ftp-message "Uncompressing %s...done" abbr))
    4309           0 :           (if (zerop (buffer-size))
    4310           0 :               (progn
    4311           0 :                 (let (ange-ftp-process-verbose)
    4312           0 :                   (delete-file file))
    4313           0 :                 (ange-ftp-copy-file-internal tmp2 nfile t nil msg2))))
    4314           0 :       (ange-ftp-del-tmp-name tmp1)
    4315           0 :       (ange-ftp-del-tmp-name tmp2))))
    4316             : 
    4317             : (defun ange-ftp-find-backup-file-name (fn)
    4318             :   ;; Either return the ordinary backup name, etc.,
    4319             :   ;; or return nil meaning don't make a backup.
    4320           0 :   (if ange-ftp-make-backup-files
    4321           0 :       (ange-ftp-real-find-backup-file-name fn)))
    4322             : 
    4323             : ;;; Define the handler for special file names
    4324             : ;;; that causes ange-ftp to be invoked.
    4325             : 
    4326             : ;;;###autoload
    4327             : (defun ange-ftp-hook-function (operation &rest args)
    4328           3 :   (let ((fn (get operation 'ange-ftp)))
    4329           3 :     (if fn
    4330             :         ;; Catch also errors in process-filter.
    4331           3 :         (condition-case err
    4332           3 :             (let ((debug-on-error t))
    4333           3 :               (save-match-data (apply fn args)))
    4334           3 :           (error (signal (car err) (cdr err))))
    4335           3 :       (ange-ftp-run-real-handler operation args))))
    4336             : 
    4337             : ;; The following code is commented out because Tramp now deals with
    4338             : ;; Ange-FTP filenames, too.
    4339             : 
    4340             : ;;-;;; This regexp takes care of real ange-ftp file names (with a slash
    4341             : ;;-;;; and colon).
    4342             : ;;-;;; Don't allow the host name to end in a period--some systems use /.:
    4343             : ;;-;;;###autoload
    4344             : ;;-(or (assoc "^/[^/:]*[^/:.]:" file-name-handler-alist)
    4345             : ;;-    (setq file-name-handler-alist
    4346             : ;;-       (cons '("^/[^/:]*[^/:.]:" . ange-ftp-hook-function)
    4347             : ;;-             file-name-handler-alist)))
    4348             : ;;-
    4349             : ;;-;;; This regexp recognizes absolute filenames with only one component,
    4350             : ;;-;;; for the sake of hostname completion.
    4351             : ;;-;;;###autoload
    4352             : ;;-(or (assoc "^/[^/:]*\\'" file-name-handler-alist)
    4353             : ;;-    (setq file-name-handler-alist
    4354             : ;;-       (cons '("^/[^/:]*\\'" . ange-ftp-completion-hook-function)
    4355             : ;;-             file-name-handler-alist)))
    4356             : ;;-
    4357             : ;;-;;; This regexp recognizes absolute filenames with only one component
    4358             : ;;-;;; on Windows, for the sake of hostname completion.
    4359             : ;;-;;; NB. Do not mark this as autoload, because it is very common to
    4360             : ;;-;;; do completions in the root directory of drives on Windows.
    4361             : ;;-(and (memq system-type '(ms-dos windows-nt))
    4362             : ;;-     (or (assoc "^[a-zA-Z]:/[^/:]*\\'" file-name-handler-alist)
    4363             : ;;-      (setq file-name-handler-alist
    4364             : ;;-            (cons '("^[a-zA-Z]:/[^/:]*\\'" .
    4365             : ;;-                    ange-ftp-completion-hook-function)
    4366             : ;;-                  file-name-handler-alist))))
    4367             : 
    4368             : ;;; The above two forms are sufficient to cause this file to be loaded
    4369             : ;;; if the user ever uses a file name with a colon in it.
    4370             : 
    4371             : ;;; This sets the mode
    4372             : (add-hook 'find-file-hook 'ange-ftp-set-buffer-mode)
    4373             : 
    4374             : ;;; Now say where to find the handlers for particular operations.
    4375             : 
    4376             : (put 'file-name-directory 'ange-ftp 'ange-ftp-file-name-directory)
    4377             : (put 'file-name-nondirectory 'ange-ftp 'ange-ftp-file-name-nondirectory)
    4378             : (put 'file-name-as-directory 'ange-ftp 'ange-ftp-file-name-as-directory)
    4379             : (put 'directory-file-name 'ange-ftp 'ange-ftp-directory-file-name)
    4380             : (put 'expand-file-name 'ange-ftp 'ange-ftp-expand-file-name)
    4381             : (put 'make-directory 'ange-ftp 'ange-ftp-make-directory)
    4382             : (put 'delete-directory 'ange-ftp 'ange-ftp-delete-directory)
    4383             : (put 'insert-file-contents 'ange-ftp 'ange-ftp-insert-file-contents)
    4384             : (put 'directory-files 'ange-ftp 'ange-ftp-directory-files)
    4385             : (put 'directory-files-and-attributes 'ange-ftp
    4386             :      'ange-ftp-directory-files-and-attributes)
    4387             : (put 'file-directory-p 'ange-ftp 'ange-ftp-file-directory-p)
    4388             : (put 'file-writable-p 'ange-ftp 'ange-ftp-file-writable-p)
    4389             : (put 'file-readable-p 'ange-ftp 'ange-ftp-file-readable-p)
    4390             : (put 'file-executable-p 'ange-ftp 'ange-ftp-file-executable-p)
    4391             : (put 'file-symlink-p 'ange-ftp 'ange-ftp-file-symlink-p)
    4392             : (put 'delete-file 'ange-ftp 'ange-ftp-delete-file)
    4393             : (put 'verify-visited-file-modtime 'ange-ftp
    4394             :      'ange-ftp-verify-visited-file-modtime)
    4395             : (put 'file-exists-p 'ange-ftp 'ange-ftp-file-exists-p)
    4396             : (put 'write-region 'ange-ftp 'ange-ftp-write-region)
    4397             : (put 'copy-file 'ange-ftp 'ange-ftp-copy-file)
    4398             : (put 'rename-file 'ange-ftp 'ange-ftp-rename-file)
    4399             : (put 'file-attributes 'ange-ftp 'ange-ftp-file-attributes)
    4400             : (put 'file-newer-than-file-p 'ange-ftp 'ange-ftp-file-newer-than-file-p)
    4401             : (put 'file-name-all-completions 'ange-ftp 'ange-ftp-file-name-all-completions)
    4402             : (put 'file-name-completion 'ange-ftp 'ange-ftp-file-name-completion)
    4403             : (put 'insert-directory 'ange-ftp 'ange-ftp-insert-directory)
    4404             : (put 'file-local-copy 'ange-ftp 'ange-ftp-file-local-copy)
    4405             : (put 'file-remote-p 'ange-ftp 'ange-ftp-file-remote-p)
    4406             : (put 'unhandled-file-name-directory 'ange-ftp
    4407             :      'ange-ftp-unhandled-file-name-directory)
    4408             : (put 'file-name-sans-versions 'ange-ftp 'ange-ftp-file-name-sans-versions)
    4409             : (put 'dired-uncache 'ange-ftp 'ange-ftp-dired-uncache)
    4410             : (put 'dired-compress-file 'ange-ftp 'ange-ftp-dired-compress-file)
    4411             : (put 'load 'ange-ftp 'ange-ftp-load)
    4412             : (put 'find-backup-file-name 'ange-ftp 'ange-ftp-find-backup-file-name)
    4413             : (put 'set-file-modes 'ange-ftp 'ange-ftp-set-file-modes)
    4414             : 
    4415             : ;; Turn off truename processing to save time.
    4416             : ;; Treat each name as its own truename.
    4417             : (put 'file-truename 'ange-ftp 'identity)
    4418             : 
    4419             : ;; We must return non-nil in order to mask our inability to do the job.
    4420             : ;; Otherwise there are errors when applied to the target file during
    4421             : ;; copying from a (localhost) Tramp file.
    4422             : (put 'set-file-times 'ange-ftp 'ignore)
    4423             : 
    4424             : ;; Turn off RCS/SCCS processing to save time.
    4425             : ;; This returns nil for any file name as argument.
    4426             : (put 'vc-registered 'ange-ftp 'null)
    4427             : 
    4428             : ;; We can handle process-file in a restricted way (just for chown).
    4429             : ;; Nothing possible for `start-file-process'.
    4430             : (put 'process-file 'ange-ftp 'ange-ftp-process-file)
    4431             : (put 'start-file-process 'ange-ftp 'ignore)
    4432             : (put 'shell-command 'ange-ftp 'ange-ftp-shell-command)
    4433             : 
    4434             : ;;; Define ways of getting at unmodified Emacs primitives,
    4435             : ;;; turning off our handler.
    4436             : 
    4437             : (defun ange-ftp-run-real-handler-orig (operation args)
    4438           0 :   (let ((inhibit-file-name-handlers
    4439           0 :          (cons 'ange-ftp-hook-function
    4440           0 :                (cons 'ange-ftp-completion-hook-function
    4441           0 :                      (and (eq inhibit-file-name-operation operation)
    4442           0 :                           inhibit-file-name-handlers))))
    4443           0 :         (inhibit-file-name-operation operation))
    4444           0 :     (apply operation args)))
    4445             : 
    4446             : (defalias 'ange-ftp-run-real-handler
    4447             :   (if (fboundp 'tramp-run-real-handler)
    4448             :       'tramp-run-real-handler 'ange-ftp-run-real-handler-orig))
    4449             : 
    4450             : (defun ange-ftp-real-file-name-directory (&rest args)
    4451           0 :   (ange-ftp-run-real-handler 'file-name-directory args))
    4452             : (defun ange-ftp-real-file-name-nondirectory (&rest args)
    4453           0 :   (ange-ftp-run-real-handler 'file-name-nondirectory args))
    4454             : (defun ange-ftp-real-file-name-as-directory (&rest args)
    4455           0 :   (ange-ftp-run-real-handler 'file-name-as-directory args))
    4456             : (defun ange-ftp-real-directory-file-name (&rest args)
    4457           0 :   (ange-ftp-run-real-handler 'directory-file-name args))
    4458             : (defun ange-ftp-real-expand-file-name (&rest args)
    4459           1 :   (ange-ftp-run-real-handler 'expand-file-name args))
    4460             : (defun ange-ftp-real-make-directory (&rest args)
    4461           0 :   (ange-ftp-run-real-handler 'make-directory args))
    4462             : (defun ange-ftp-real-delete-directory (&rest args)
    4463           0 :   (ange-ftp-run-real-handler 'delete-directory args))
    4464             : (defun ange-ftp-real-insert-file-contents (&rest args)
    4465           0 :   (ange-ftp-run-real-handler 'insert-file-contents args))
    4466             : (defun ange-ftp-real-directory-files (&rest args)
    4467           0 :   (ange-ftp-run-real-handler 'directory-files args))
    4468             : (defun ange-ftp-real-directory-files-and-attributes (&rest args)
    4469           0 :   (ange-ftp-run-real-handler 'directory-files-and-attributes args))
    4470             : (defun ange-ftp-real-file-directory-p (&rest args)
    4471           0 :   (ange-ftp-run-real-handler 'file-directory-p args))
    4472             : (defun ange-ftp-real-file-writable-p (&rest args)
    4473           0 :   (ange-ftp-run-real-handler 'file-writable-p args))
    4474             : (defun ange-ftp-real-file-readable-p (&rest args)
    4475           0 :   (ange-ftp-run-real-handler 'file-readable-p args))
    4476             : (defun ange-ftp-real-file-executable-p (&rest args)
    4477           0 :   (ange-ftp-run-real-handler 'file-executable-p args))
    4478             : (defun ange-ftp-real-file-symlink-p (&rest args)
    4479           1 :   (ange-ftp-run-real-handler 'file-symlink-p args))
    4480             : (defun ange-ftp-real-delete-file (&rest args)
    4481           0 :   (ange-ftp-run-real-handler 'delete-file args))
    4482             : (defun ange-ftp-real-verify-visited-file-modtime (&rest args)
    4483           0 :   (ange-ftp-run-real-handler 'verify-visited-file-modtime args))
    4484             : (defun ange-ftp-real-file-exists-p (&rest args)
    4485           0 :   (ange-ftp-run-real-handler 'file-exists-p args))
    4486             : (defun ange-ftp-real-write-region (&rest args)
    4487           0 :   (ange-ftp-run-real-handler 'write-region args))
    4488             : (defun ange-ftp-real-backup-buffer (&rest args)
    4489           0 :   (ange-ftp-run-real-handler 'backup-buffer args))
    4490             : (defun ange-ftp-real-copy-file (&rest args)
    4491           0 :   (ange-ftp-run-real-handler 'copy-file args))
    4492             : (defun ange-ftp-real-rename-file (&rest args)
    4493           0 :   (ange-ftp-run-real-handler 'rename-file args))
    4494             : (defun ange-ftp-real-file-attributes (&rest args)
    4495           1 :   (ange-ftp-run-real-handler 'file-attributes args))
    4496             : (defun ange-ftp-real-file-newer-than-file-p (&rest args)
    4497           0 :   (ange-ftp-run-real-handler 'file-newer-than-file-p args))
    4498             : (defun ange-ftp-real-file-name-all-completions (&rest args)
    4499           0 :   (ange-ftp-run-real-handler 'file-name-all-completions args))
    4500             : (defun ange-ftp-real-file-name-completion (&rest args)
    4501           0 :   (ange-ftp-run-real-handler 'file-name-completion args))
    4502             : (defun ange-ftp-real-insert-directory (&rest args)
    4503           0 :   (ange-ftp-run-real-handler 'insert-directory args))
    4504             : (defun ange-ftp-real-file-name-sans-versions (&rest args)
    4505           0 :   (ange-ftp-run-real-handler 'file-name-sans-versions args))
    4506             : (defun ange-ftp-real-shell-command (&rest args)
    4507           0 :   (ange-ftp-run-real-handler 'shell-command args))
    4508             : (defun ange-ftp-real-load (&rest args)
    4509           0 :   (ange-ftp-run-real-handler 'load args))
    4510             : (defun ange-ftp-real-find-backup-file-name (&rest args)
    4511           0 :   (ange-ftp-run-real-handler 'find-backup-file-name args))
    4512             : 
    4513             : ;; Here we support using dired on remote hosts.
    4514             : ;; I have turned off the support for using dired on foreign directory formats.
    4515             : ;; That involves too many unclean hooks.
    4516             : ;; It would be cleaner to support such operations by
    4517             : ;; converting the foreign directory format to something dired can understand;
    4518             : ;; something close to ls -l output.
    4519             : ;; The logical place to do this is in the functions ange-ftp-parse-...-listing.
    4520             : 
    4521             : ;; Some of the old dired hooks would still be needed even if this is done.
    4522             : ;; I have preserved (and modernized) those hooks.
    4523             : ;; So the format conversion should be all that is needed.
    4524             : 
    4525             : ;; When called from dired, SWITCHES may start with "--dired".
    4526             : ;; `ange-ftp-ls' handles this.
    4527             : 
    4528             : (defun ange-ftp-insert-directory (file switches &optional wildcard full)
    4529           0 :   (if (not (ange-ftp-ftp-name (expand-file-name file)))
    4530           0 :       (ange-ftp-real-insert-directory file switches wildcard full)
    4531             :     ;; We used to follow symlinks on `file' here.  Apparently it was done
    4532             :     ;; because some FTP servers react to "ls foo" by listing the symlink foo
    4533             :     ;; rather than the directory it points to.  Now that ange-ftp-ls uses
    4534             :     ;; "cd foo; ls" instead, this is not necessary any more.
    4535           0 :     (let ((beg (point))
    4536           0 :           (end (point-marker)))
    4537           0 :       (set-marker-insertion-type end t)
    4538           0 :       (insert
    4539           0 :        (cond
    4540           0 :         (wildcard
    4541           0 :          (let ((default-directory (file-name-directory file)))
    4542           0 :            (ange-ftp-ls (file-name-nondirectory file) switches nil nil t)))
    4543           0 :         (full
    4544           0 :          (ange-ftp-ls file switches 'parse))
    4545             :         (t
    4546             :          ;; If `full' is nil we're going to do `ls' for a single file.
    4547             :          ;; Problem is that for various reasons, ange-ftp-ls needs to cd and
    4548             :          ;; then do an ls of current dir, which obviously won't work if we
    4549             :          ;; want to ls a file.  So instead, we get a full listing of the
    4550             :          ;; parent directory and extract the line corresponding to `file'.
    4551           0 :          (when (string-match "-?d\\'" switches)
    4552             :            ;; Remove "d" which dired added to `switches'.
    4553           0 :            (setq switches (substring switches 0 (match-beginning 0))))
    4554           0 :          (setq file (directory-file-name file))
    4555           0 :          (let* ((dirlist (ange-ftp-ls (or (file-name-directory file) ".")
    4556           0 :                                       switches 'parse))
    4557           0 :                 (filename (file-name-nondirectory file))
    4558             :                 (case-fold-search nil))
    4559             :            ;; FIXME: This presumes a particular output format, which is
    4560             :            ;; basically Unix.
    4561           0 :            (if (string-match (concat "^.+[^ ] " (regexp-quote filename)
    4562           0 :                                      "\\( -> .*\\)?[@/*=]?\n") dirlist)
    4563           0 :                (match-string 0 dirlist)
    4564           0 :              "")))))
    4565             : 
    4566             :       ;; Insert "  " for dired's alignment sanity.
    4567           0 :       (goto-char beg)
    4568           0 :       (while (re-search-forward "^\\(\\S-\\)" end 'move)
    4569           0 :         (replace-match "  \\1"))
    4570             : 
    4571             :       ;; The inserted file could be from somewhere else.
    4572           0 :       (when (and (not wildcard) (not full)
    4573           0 :                  (search-backward
    4574           0 :                   (if (zerop (length (file-name-nondirectory
    4575           0 :                                       (expand-file-name file))))
    4576             :                       "."
    4577           0 :                     (file-name-nondirectory file))
    4578           0 :                   nil 'noerror))
    4579           0 :         (replace-match (file-relative-name (expand-file-name file)) t)
    4580           0 :         (goto-char end))
    4581             : 
    4582           0 :       (set-marker end nil))))
    4583             : 
    4584             : (defun ange-ftp-dired-uncache (dir)
    4585           0 :   (if (ange-ftp-ftp-name (expand-file-name dir))
    4586           0 :       (setq ange-ftp-ls-cache-file nil)))
    4587             : 
    4588             : (defvar ange-ftp-sans-version-alist nil
    4589             :   "Alist of mapping host type into function to remove file version numbers.")
    4590             : 
    4591             : (defun ange-ftp-file-name-sans-versions (file keep-backup-version)
    4592           0 :   (let* ((short (ange-ftp-abbreviate-filename file))
    4593           0 :          (parsed (ange-ftp-ftp-name short))
    4594           0 :          (func (if parsed (cdr (assq (ange-ftp-host-type (car parsed))
    4595           0 :                                      ange-ftp-sans-version-alist)))))
    4596           0 :     (if func (funcall func file keep-backup-version)
    4597           0 :       (ange-ftp-real-file-name-sans-versions file keep-backup-version))))
    4598             : 
    4599             : ;; This is the handler for shell-command.
    4600             : (defun ange-ftp-shell-command (command &optional output-buffer error-buffer)
    4601           0 :   (let* ((parsed (ange-ftp-ftp-name default-directory))
    4602           0 :          (host (nth 0 parsed))
    4603           0 :          (name (nth 2 parsed)))
    4604           0 :     (if (not parsed)
    4605           0 :         (ange-ftp-real-shell-command command output-buffer error-buffer)
    4606           0 :       (if (> (length name) 0)                ; else it's $HOME
    4607           0 :           (setq command (concat "cd " name "; " command)))
    4608             :       ;; Remove port from the hostname
    4609           0 :       (when (string-match "\\(.*\\)#" host)
    4610           0 :         (setq host (match-string 1 host)))
    4611           0 :       (setq command
    4612           0 :             (format  "%s %s \"%s\"" ; remsh -l USER does not work well
    4613             :                                         ; on a hp-ux machine I tried
    4614           0 :                      remote-shell-program host command))
    4615           0 :       (ange-ftp-message "Remote command `%s' ..." command)
    4616             :       ;; Cannot call ange-ftp-real-dired-run-shell-command here as it
    4617             :       ;; would prepend "cd default-directory" --- which bombs because
    4618             :       ;; default-directory is in ange-ftp syntax for remote file names.
    4619           0 :       (ange-ftp-real-shell-command command output-buffer error-buffer))))
    4620             : 
    4621             : ;;; This is the handler for process-file.
    4622             : (defun ange-ftp-process-file (program infile buffer display &rest arguments)
    4623             :   ;; PROGRAM is always one of those below in the cond in dired.el.
    4624             :   ;; The ARGUMENTS are (nearly) always files.
    4625           0 :   (if (ange-ftp-ftp-name default-directory)
    4626             :       ;; Can't use ange-ftp-dired-host-type here because the current
    4627             :       ;; buffer is *dired-check-process output*
    4628           0 :       (condition-case oops
    4629           0 :           (cond ((equal (or (bound-and-true-p dired-chmod-program) "chmod")
    4630           0 :                         program)
    4631           0 :                  (ange-ftp-call-chmod arguments))
    4632             :                 ;; ((equal "chgrp" program))
    4633             :                 ;; ((equal dired-chown-program program))
    4634           0 :                 (t (error "Unknown remote command: %s" program)))
    4635           0 :         (ftp-error (insert (format "%s: %s, %s\n"
    4636           0 :                                    (nth 1 oops)
    4637           0 :                                    (nth 2 oops)
    4638           0 :                                    (nth 3 oops)))
    4639             :                    ;; Caller expects nonzero value to mean failure.
    4640             :                    1)
    4641           0 :         (error (insert (format "%s\n" (nth 1 oops)))
    4642           0 :                1))
    4643           0 :     (apply 'call-process program infile buffer display arguments)))
    4644             : 
    4645             : ;; Handle an attempt to run chmod on a remote file
    4646             : ;; by using the ftp chmod command.
    4647             : (defun ange-ftp-call-chmod (args)
    4648           0 :   (if (< (length args) 2)
    4649           0 :       (error "ange-ftp-call-chmod: missing mode and/or filename: %s" args))
    4650           0 :   (let ((mode (car args))
    4651           0 :         (rest (cdr args)))
    4652           0 :     (if (equal "--" (car rest))
    4653           0 :         (setq rest (cdr rest)))
    4654           0 :     (mapc
    4655             :      (lambda (file)
    4656           0 :        (setq file (expand-file-name file))
    4657           0 :        (let ((parsed (ange-ftp-ftp-name file)))
    4658           0 :          (if parsed
    4659           0 :              (let* ((host (nth 0 parsed))
    4660           0 :                     (user (nth 1 parsed))
    4661           0 :                     (name (ange-ftp-quote-string (nth 2 parsed)))
    4662           0 :                     (abbr (ange-ftp-abbreviate-filename file))
    4663           0 :                     (result (ange-ftp-send-cmd host user
    4664           0 :                                                (list 'chmod mode name)
    4665           0 :                                                (format "doing chmod %s"
    4666           0 :                                                        abbr))))
    4667           0 :                (or (car result)
    4668           0 :                    (ange-ftp-error
    4669           0 :                     host user (concat "CHMOD failed: " (cdr result))))))))
    4670           0 :      rest))
    4671           0 :   (setq ange-ftp-ls-cache-file nil)     ;Stop confusing Dired.
    4672             :   0)
    4673             : 
    4674             : (defun ange-ftp-set-file-modes (filename mode)
    4675           0 :   (ange-ftp-call-chmod (list (format "%o" mode) filename)))
    4676             : 
    4677             : ;; This is turned off because it has nothing properly to do
    4678             : ;; with dired.  It could be reasonable to adapt this to
    4679             : ;; replace ange-ftp-copy-file.
    4680             : 
    4681             : ;;;;; ------------------------------------------------------------
    4682             : ;;;;; Noddy support for async copy-file within dired.
    4683             : ;;;;; ------------------------------------------------------------
    4684             : 
    4685             : ;;(defun ange-ftp-dired-copy-file (from to ok-flag &optional cont nowait)
    4686             : ;;  "Documented as original."
    4687             : ;;  (dired-handle-overwrite to)
    4688             : ;;  (ange-ftp-copy-file-internal from to ok-flag dired-copy-preserve-time nil
    4689             : ;;                             cont nowait))
    4690             : 
    4691             : ;;(defun ange-ftp-dired-do-create-files (op-symbol file-creator operation arg
    4692             : ;;                                               &optional marker-char op1
    4693             : ;;                                               how-to)
    4694             : ;;  "Documented as original."
    4695             : ;;  ;; we need to let ange-ftp-dired-create-files know that we indirectly
    4696             : ;;  ;; called it rather than somebody else.
    4697             : ;;  (let ((ange-ftp-dired-do-create-files t)) ; tell who caller is
    4698             : ;;    (ange-ftp-real-dired-do-create-files op-symbol file-creator operation
    4699             : ;;                                       arg marker-char op1 how-to)))
    4700             : 
    4701             : ;;(defun ange-ftp-dired-create-files (file-creator operation fn-list name-constructor
    4702             : ;;                                               &optional marker-char)
    4703             : ;;  "Documented as original."
    4704             : ;;  (if (and (boundp 'ange-ftp-dired-do-create-files)
    4705             : ;;         ;; called from ange-ftp-dired-do-create-files?
    4706             : ;;         ange-ftp-dired-do-create-files
    4707             : ;;         ;; any files worth copying?
    4708             : ;;         fn-list
    4709             : ;;         ;; we only support async copy-file at the mo.
    4710             : ;;         (eq file-creator 'dired-copy-file)
    4711             : ;;         ;; it is only worth calling the alternative function for remote files
    4712             : ;;         ;; as we tie ourself in recursive knots otherwise.
    4713             : ;;         (or (ange-ftp-ftp-name (car fn-list))
    4714             : ;;             ;; we can only call the name constructor for dired-do-create-files
    4715             : ;;             ;; since the one for regexps starts prompting here, there and
    4716             : ;;             ;; everywhere.
    4717             : ;;             (ange-ftp-ftp-name (funcall name-constructor (car fn-list)))))
    4718             : ;;      ;; use the process-filter driven routine rather than the iterative one.
    4719             : ;;      (ange-ftp-dcf-1 file-creator
    4720             : ;;                    operation
    4721             : ;;                    fn-list
    4722             : ;;                    name-constructor
    4723             : ;;                    (and (boundp 'target) target)     ;dynamically bound
    4724             : ;;                    marker-char
    4725             : ;;                    (current-buffer)
    4726             : ;;                    nil       ;overwrite-query
    4727             : ;;                    nil       ;overwrite-backup-query
    4728             : ;;                    nil       ;failures
    4729             : ;;                    nil       ;skipped
    4730             : ;;                    0         ;success-count
    4731             : ;;                    (length fn-list) ;total
    4732             : ;;                    )
    4733             : ;;    ;; normal case... use the interactive routine... much cheaper.
    4734             : ;;    (ange-ftp-real-dired-create-files file-creator operation fn-list
    4735             : ;;                                    name-constructor marker-char)))
    4736             : 
    4737             : ;;(defun ange-ftp-dcf-1 (file-creator operation fn-list name-constructor
    4738             : ;;                     target marker-char buffer overwrite-query
    4739             : ;;                     overwrite-backup-query failures skipped
    4740             : ;;                     success-count total)
    4741             : ;;  (with-current-buffer buffer
    4742             : ;;        (if (null fn-list)
    4743             : ;;            (ange-ftp-dcf-3 failures operation total skipped
    4744             : ;;                            success-count buffer)
    4745             : 
    4746             : ;;          (let* ((from (car fn-list))
    4747             : ;;                 (to (funcall name-constructor from)))
    4748             : ;;            (if (equal to from)
    4749             : ;;                (progn
    4750             : ;;                  (setq to nil)
    4751             : ;;                  (dired-log "Cannot %s to same file: %s\n"
    4752             : ;;                             (downcase operation) from)))
    4753             : ;;            (if (not to)
    4754             : ;;                (ange-ftp-dcf-1 file-creator
    4755             : ;;                                operation
    4756             : ;;                                (cdr fn-list)
    4757             : ;;                                name-constructor
    4758             : ;;                                target
    4759             : ;;                                marker-char
    4760             : ;;                                buffer
    4761             : ;;                                overwrite-query
    4762             : ;;                                overwrite-backup-query
    4763             : ;;                                failures
    4764             : ;;                                (cons (dired-make-relative from) skipped)
    4765             : ;;                                success-count
    4766             : ;;                                total)
    4767             : ;;              (let* ((overwrite (file-exists-p to))
    4768             : ;;                     (overwrite-confirmed     ; for dired-handle-overwrite
    4769             : ;;                      (and overwrite
    4770             : ;;                           (let ((help-form '(format "\
    4771             : ;;Type SPC or `y' to overwrite file `%s',
    4772             : ;;DEL or `n' to skip to next,
    4773             : ;;ESC or `q' to not overwrite any of the remaining files,
    4774             : ;;`!' to overwrite all remaining files with no more questions." to)))
    4775             : ;;                             (dired-query 'overwrite-query
    4776             : ;;                                          "Overwrite `%s'?" to))))
    4777             : ;;                     ;; must determine if FROM is marked before file-creator
    4778             : ;;                     ;; gets a chance to delete it (in case of a move).
    4779             : ;;                     (actual-marker-char
    4780             : ;;                      (cond  ((integerp marker-char) marker-char)
    4781             : ;;                             (marker-char (dired-file-marker from)) ; slow
    4782             : ;;                             (t nil))))
    4783             : ;;                (condition-case err
    4784             : ;;                    (funcall file-creator from to overwrite-confirmed
    4785             : ;;                             (list 'ange-ftp-dcf-2
    4786             : ;;                                   nil        ;err
    4787             : ;;                                   file-creator operation fn-list
    4788             : ;;                                   name-constructor
    4789             : ;;                                   target
    4790             : ;;                                   marker-char actual-marker-char
    4791             : ;;                                   buffer to from
    4792             : ;;                                   overwrite
    4793             : ;;                                   overwrite-confirmed
    4794             : ;;                                   overwrite-query
    4795             : ;;                                   overwrite-backup-query
    4796             : ;;                                   failures skipped success-count
    4797             : ;;                                   total)
    4798             : ;;                             t)
    4799             : ;;                  (file-error         ; FILE-CREATOR aborted
    4800             : ;;                   (ange-ftp-dcf-2 nil ;result
    4801             : ;;                                   nil ;line
    4802             : ;;                                   err
    4803             : ;;                                   file-creator operation fn-list
    4804             : ;;                                   name-constructor
    4805             : ;;                                   target
    4806             : ;;                                   marker-char actual-marker-char
    4807             : ;;                                   buffer to from
    4808             : ;;                                   overwrite
    4809             : ;;                                   overwrite-confirmed
    4810             : ;;                                   overwrite-query
    4811             : ;;                                   overwrite-backup-query
    4812             : ;;                                   failures skipped success-count
    4813             : ;;                                   total)))))))))
    4814             : 
    4815             : ;;(defun ange-ftp-dcf-2 (result line err
    4816             : ;;                            file-creator operation fn-list
    4817             : ;;                            name-constructor
    4818             : ;;                            target
    4819             : ;;                            marker-char actual-marker-char
    4820             : ;;                            buffer to from
    4821             : ;;                            overwrite
    4822             : ;;                            overwrite-confirmed
    4823             : ;;                            overwrite-query
    4824             : ;;                            overwrite-backup-query
    4825             : ;;                            failures skipped success-count
    4826             : ;;                            total)
    4827             : ;;  (with-current-buffer buffer
    4828             : ;;        (if (or err (not result))
    4829             : ;;            (progn
    4830             : ;;              (setq failures (cons (dired-make-relative from) failures))
    4831             : ;;              (dired-log "%s `%s' to `%s' failed:\n%s\n"
    4832             : ;;                         operation from to (or err line)))
    4833             : ;;          (if overwrite
    4834             : ;;              ;; If we get here, file-creator hasn't been aborted
    4835             : ;;              ;; and the old entry (if any) has to be deleted
    4836             : ;;              ;; before adding the new entry.
    4837             : ;;              (dired-remove-file to))
    4838             : ;;          (setq success-count (1+ success-count))
    4839             : ;;          (message "%s: %d of %d" operation success-count total)
    4840             : ;;          (dired-add-file to actual-marker-char))
    4841             : 
    4842             : ;;        (ange-ftp-dcf-1 file-creator operation (cdr fn-list)
    4843             : ;;                        name-constructor
    4844             : ;;                        target
    4845             : ;;                        marker-char
    4846             : ;;                        buffer
    4847             : ;;                        overwrite-query
    4848             : ;;                        overwrite-backup-query
    4849             : ;;                        failures skipped success-count
    4850             : ;;                        total)))
    4851             : 
    4852             : ;;(defun ange-ftp-dcf-3 (failures operation total skipped success-count
    4853             : ;;                              buffer)
    4854             : ;;  (with-current-buffer buffer
    4855             : ;;        (cond
    4856             : ;;         (failures
    4857             : ;;          (dired-log-summary
    4858             : ;;           (message "%s failed for %d of %d file%s %s"
    4859             : ;;                    operation (length failures) total
    4860             : ;;                    (dired-plural-s total) failures)))
    4861             : ;;         (skipped
    4862             : ;;          (dired-log-summary
    4863             : ;;           (message "%s: %d of %d file%s skipped %s"
    4864             : ;;                    operation (length skipped) total
    4865             : ;;                    (dired-plural-s total) skipped)))
    4866             : ;;         (t
    4867             : ;;          (message "%s: %s file%s."
    4868             : ;;                   operation success-count (dired-plural-s success-count))))
    4869             : ;;        (dired-move-to-filename)))
    4870             : 
    4871             : ;;;; -----------------------------------------------
    4872             : ;;;; Unix Descriptive Listing (dl) Support
    4873             : ;;;; -----------------------------------------------
    4874             : 
    4875             : ;; This is turned off because nothing uses it currently
    4876             : ;; and because I don't understand what it's supposed to be for. --rms.
    4877             : 
    4878             : ;;(defconst ange-ftp-dired-dl-re-dir
    4879             : ;;  "^. [^ /]+/[ \n]"
    4880             : ;;  "Regular expression to use to search for dl directories.")
    4881             : 
    4882             : ;;(or (assq 'unix:dl ange-ftp-dired-re-dir-alist)
    4883             : ;;    (setq ange-ftp-dired-re-dir-alist
    4884             : ;;        (cons (cons 'unix:dl  ange-ftp-dired-dl-re-dir)
    4885             : ;;              ange-ftp-dired-re-dir-alist)))
    4886             : 
    4887             : ;;(defun ange-ftp-dired-dl-move-to-filename (&optional raise-error eol)
    4888             : ;;  "In dired, move to the first character of the filename on this line."
    4889             : ;;  ;; This is the Unix dl version.
    4890             : ;;  (or eol (setq eol (progn (end-of-line) (point))))
    4891             : ;;  (let (case-fold-search)
    4892             : ;;    (beginning-of-line)
    4893             : ;;    (if (looking-at ". [^ ]+ +\\([0-9]+\\|-\\|=\\) ")
    4894             : ;;      (goto-char (+ (point) 2))
    4895             : ;;      (if raise-error
    4896             : ;;        (error "No file on this line")
    4897             : ;;      nil))))
    4898             : 
    4899             : ;;(or (assq 'unix:dl ange-ftp-dired-move-to-filename-alist)
    4900             : ;;    (setq ange-ftp-dired-move-to-filename-alist
    4901             : ;;        (cons '(unix:dl . ange-ftp-dired-dl-move-to-filename)
    4902             : ;;              ange-ftp-dired-move-to-filename-alist)))
    4903             : 
    4904             : ;;(defun ange-ftp-dired-dl-move-to-end-of-filename (&optional no-error eol)
    4905             : ;;  ;; Assumes point is at beginning of filename.
    4906             : ;;  ;; So, it should be called only after (dired-move-to-filename t).
    4907             : ;;  ;; On failure, signals an error or returns nil.
    4908             : ;;  ;; This is the Unix dl version.
    4909             : ;;  (let ((opoint (point))
    4910             : ;;      case-fold-search hidden)
    4911             : ;;    (or eol (setq eol (line-end-position)))
    4912             : ;;    (setq hidden (and selective-display
    4913             : ;;                     (save-excursion
    4914             : ;;                       (search-forward "\r" eol t))))
    4915             : ;;    (if hidden
    4916             : ;;      (if no-error
    4917             : ;;          nil
    4918             : ;;        (error
    4919             : ;;         (substitute-command-keys
    4920             : ;;          "File line is hidden, type \\[dired-hide-subdir] to unhide")))
    4921             : ;;      (skip-chars-forward "^ /" eol)
    4922             : ;;      (if (eq opoint (point))
    4923             : ;;        (if no-error
    4924             : ;;            nil
    4925             : ;;          (error "No file on this line"))
    4926             : ;;      (point)))))
    4927             : 
    4928             : ;;(or (assq 'unix:dl ange-ftp-dired-move-to-end-of-filename-alist)
    4929             : ;;    (setq ange-ftp-dired-move-to-end-of-filename-alist
    4930             : ;;        (cons '(unix:dl . ange-ftp-dired-dl-move-to-end-of-filename)
    4931             : ;;              ange-ftp-dired-move-to-end-of-filename-alist)))
    4932             : 
    4933             : ;;;; ------------------------------------------------------------
    4934             : ;;;; VOS support (VOS support is probably broken,
    4935             : ;;;; but I don't know anything about VOS.)
    4936             : ;;;; ------------------------------------------------------------
    4937             : ;
    4938             : ;(defun ange-ftp-fix-name-for-vos (name &optional reverse)
    4939             : ;  (setq name (copy-sequence name))
    4940             : ;  (let ((from (if reverse ?\> ?\/))
    4941             : ;       (to (if reverse ?\/ ?\>))
    4942             : ;       (i (1- (length name))))
    4943             : ;    (while (>= i 0)
    4944             : ;      (if (= (aref name i) from)
    4945             : ;         (aset name i to))
    4946             : ;      (setq i (1- i)))
    4947             : ;    name))
    4948             : ;
    4949             : ;(or (assq 'vos ange-ftp-fix-name-func-alist)
    4950             : ;    (setq ange-ftp-fix-name-func-alist
    4951             : ;         (cons '(vos . ange-ftp-fix-name-for-vos)
    4952             : ;               ange-ftp-fix-name-func-alist)))
    4953             : ;
    4954             : ;(or (memq 'vos ange-ftp-dumb-host-types)
    4955             : ;    (setq ange-ftp-dumb-host-types
    4956             : ;         (cons 'vos ange-ftp-dumb-host-types)))
    4957             : ;
    4958             : ;(defun ange-ftp-fix-dir-name-for-vos (dir-name)
    4959             : ;  (ange-ftp-fix-name-for-vos
    4960             : ;   (concat dir-name
    4961             : ;          (if (eq ?/ (aref dir-name (1- (length dir-name))))
    4962             : ;              "" "/")
    4963             : ;          "*")))
    4964             : ;
    4965             : ;(or (assq 'vos ange-ftp-fix-dir-name-func-alist)
    4966             : ;    (setq ange-ftp-fix-dir-name-func-alist
    4967             : ;         (cons '(vos . ange-ftp-fix-dir-name-for-vos)
    4968             : ;               ange-ftp-fix-dir-name-func-alist)))
    4969             : ;
    4970             : ;(defvar ange-ftp-vos-host-regexp nil
    4971             : ;  "If a host matches this regexp then it is assumed to be running VOS.")
    4972             : ;
    4973             : ;(defun ange-ftp-vos-host (host)
    4974             : ;  (and ange-ftp-vos-host-regexp
    4975             : ;       (save-match-data
    4976             : ;        (string-match ange-ftp-vos-host-regexp host))))
    4977             : ;
    4978             : ;(defun ange-ftp-parse-vos-listing ()
    4979             : ;  "Parse the current buffer which is assumed to be in VOS list -all
    4980             : ;format, and return a hashtable as the result."
    4981             : ;  (let ((tbl (ange-ftp-make-hashtable))
    4982             : ;       (type-list
    4983             : ;        '(("^Files: [0-9]+ +Blocks: [0-9]+\n+" nil 40)
    4984             : ;          ("^Dirs: [0-9]+\n+" t 30)))
    4985             : ;       type-regexp type-is-dir type-col file)
    4986             : ;    (goto-char (point-min))
    4987             : ;    (save-match-data
    4988             : ;      (while type-list
    4989             : ;       (setq type-regexp (car (car type-list))
    4990             : ;             type-is-dir (nth 1 (car type-list))
    4991             : ;             type-col (nth 2 (car type-list))
    4992             : ;             type-list (cdr type-list))
    4993             : ;       (if (re-search-forward type-regexp nil t)
    4994             : ;           (while (eq (char-after (point)) ? )
    4995             : ;             (move-to-column type-col)
    4996             : ;             (setq file (buffer-substring (point)
    4997             : ;                                          (progn
    4998             : ;                                            (end-of-line 1)
    4999             : ;                                            (point))))
    5000             : ;             (puthash file type-is-dir tbl)
    5001             : ;             (forward-line 1))))
    5002             : ;      (puthash "." 'vosdir tbl)
    5003             : ;      (puthash ".." 'vosdir tbl))
    5004             : ;    tbl))
    5005             : ;
    5006             : ;(or (assq 'vos ange-ftp-parse-list-func-alist)
    5007             : ;    (setq ange-ftp-parse-list-func-alist
    5008             : ;         (cons '(vos . ange-ftp-parse-vos-listing)
    5009             : ;               ange-ftp-parse-list-func-alist)))
    5010             : 
    5011             : ;;;; ------------------------------------------------------------
    5012             : ;;;; VMS support.
    5013             : ;;;; ------------------------------------------------------------
    5014             : 
    5015             : ;; Convert NAME from UNIX-ish to VMS.  If REVERSE given then convert from VMS
    5016             : ;; to UNIX-ish.
    5017             : (defun ange-ftp-fix-name-for-vms (name &optional reverse)
    5018           0 :   (save-match-data
    5019           0 :     (if reverse
    5020           0 :         (if (string-match "\\`\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)\\'" name)
    5021           0 :             (let (drive dir file)
    5022           0 :               (setq drive (match-string 1 name))
    5023           0 :               (setq dir (match-string 2 name))
    5024           0 :               (setq file (match-string 3 name))
    5025           0 :               (and dir
    5026           0 :                    (setq dir (subst-char-in-string
    5027           0 :                               ?/ ?. (substring dir 1 -1) t)))
    5028           0 :               (concat (and drive
    5029           0 :                            (concat "/" drive "/"))
    5030           0 :                       dir (and dir "/")
    5031           0 :                       file))
    5032           0 :           (error "name %s didn't match" name))
    5033           0 :       (let (drive dir file tmp quote)
    5034           0 :         (if (string-match "\\`\".+\"\\'" name)
    5035           0 :             (setq name (substring name 1 -1)
    5036           0 :                   quote "\"")
    5037           0 :           (setq quote ""))
    5038           0 :         (if (string-match "\\`/[^:]+:/" name)
    5039           0 :             (setq drive (substring name 1
    5040           0 :                                    (1- (match-end 0)))
    5041           0 :                   name (substring name (match-end 0))))
    5042           0 :         (setq tmp (file-name-directory name))
    5043           0 :         (if tmp
    5044           0 :             (setq dir (subst-char-in-string ?/ ?. (substring tmp 0 -1) t)))
    5045           0 :         (setq file (file-name-nondirectory name))
    5046           0 :         (concat quote drive
    5047           0 :                 (and dir (concat "[" (if drive nil ".") dir "]"))
    5048           0 :                 file quote)))))
    5049             : 
    5050             : ;; (ange-ftp-fix-name-for-vms "/PUB$:/ANONYMOUS/SDSCPUB/NEXT/Readme.txt;1")
    5051             : ;; (ange-ftp-fix-name-for-vms "/PUB$:[ANONYMOUS.SDSCPUB.NEXT]Readme.txt;1" t)
    5052             : 
    5053             : (or (assq 'vms ange-ftp-fix-name-func-alist)
    5054             :     (setq ange-ftp-fix-name-func-alist
    5055             :           (cons '(vms . ange-ftp-fix-name-for-vms)
    5056             :                 ange-ftp-fix-name-func-alist)))
    5057             : 
    5058             : (or (memq 'vms ange-ftp-dumb-host-types)
    5059             :     (setq ange-ftp-dumb-host-types
    5060             :           (cons 'vms ange-ftp-dumb-host-types)))
    5061             : 
    5062             : ;; It is important that this function barf for directories for which we know
    5063             : ;; that we cannot possibly get a directory listing, such as "/" and "/DEV:/".
    5064             : ;; This is because it saves an unnecessary FTP error, or possibly the listing
    5065             : ;; might succeed, but give erroneous info. This last case is particularly
    5066             : ;; likely for OS's (like MTS) for which we need to use a wildcard in order
    5067             : ;; to list a directory.
    5068             : 
    5069             : ;; Convert name from UNIX-ish to VMS ready for a DIRectory listing.
    5070             : (defun ange-ftp-fix-dir-name-for-vms (dir-name)
    5071             :   ;; Should there be entries for .. -> [-] and . -> [] below. Don't
    5072             :   ;; think so, because expand-filename should have already short-circuited
    5073             :   ;; them.
    5074           0 :   (cond ((string-equal dir-name "/")
    5075           0 :          (error "Cannot get listing for fictitious \"/\" directory"))
    5076           0 :         ((string-match "\\`/[-A-Z0-9_$]+:/\\'" dir-name)
    5077           0 :          (error "Cannot get listing for device"))
    5078           0 :         ((ange-ftp-fix-name-for-vms dir-name))))
    5079             : 
    5080             : (or (assq 'vms ange-ftp-fix-dir-name-func-alist)
    5081             :     (setq ange-ftp-fix-dir-name-func-alist
    5082             :           (cons '(vms . ange-ftp-fix-dir-name-for-vms)
    5083             :                 ange-ftp-fix-dir-name-func-alist)))
    5084             : 
    5085             : (defvar ange-ftp-vms-host-regexp nil)
    5086             : 
    5087             : ;; Return non-nil if HOST is running VMS.
    5088             : (defun ange-ftp-vms-host (host)
    5089           0 :   (and ange-ftp-vms-host-regexp
    5090           0 :        (string-match-p ange-ftp-vms-host-regexp host)))
    5091             : 
    5092             : ;; Because some VMS ftp servers convert filenames to lower case
    5093             : ;; we allow a-z in the filename regexp. I'm not too happy about this.
    5094             : 
    5095             : (defconst ange-ftp-vms-filename-regexp
    5096             :   (concat
    5097             :    "\\(\\([_A-Za-z0-9$]?\\|[_A-Za-z0-9$][-_A-Za-z0-9$]*\\)\\."
    5098             :    "[-_A-Za-z0-9$]*;+[0-9]*\\)")
    5099             :   "Regular expression to match for a valid VMS file name in Dired buffer.
    5100             : Stupid freaking bug!  Position of _ and $ shouldn't matter but they do.
    5101             : Having [A-Z0-9$_] bombs on filename _$$CHANGE_LOG$.TXT$ and $CHANGE_LOG$.TX.
    5102             : Other orders of $ and _ seem to all work just fine.")
    5103             : 
    5104             : ;; These parsing functions are as general as possible because the syntax
    5105             : ;; of ftp listings from VMS hosts is a bit erratic. What saves us is that
    5106             : ;; the VMS filename syntax is so rigid. If they bomb on a listing in the
    5107             : ;; standard VMS Multinet format, then this is a bug. If they bomb on a listing
    5108             : ;; from vms.weird.net, then too bad.
    5109             : 
    5110             : ;; Extract the next filename from a VMS dired-like listing.
    5111             : (defun ange-ftp-parse-vms-filename ()
    5112           0 :   (if (re-search-forward
    5113           0 :        ange-ftp-vms-filename-regexp
    5114           0 :        nil t)
    5115           0 :       (match-string 0)))
    5116             : 
    5117             : ;; Parse the current buffer which is assumed to be in MultiNet FTP dir
    5118             : ;; format, and return a hashtable as the result.
    5119             : (defun ange-ftp-parse-vms-listing ()
    5120           0 :   (let ((tbl (make-hash-table :test 'equal))
    5121             :         file)
    5122           0 :     (goto-char (point-min))
    5123           0 :     (save-match-data
    5124           0 :       (while (setq file (ange-ftp-parse-vms-filename))
    5125           0 :         (if (string-match "\\.\\(DIR\\|dir\\);[0-9]+" file)
    5126             :             ;; deal with directories
    5127           0 :             (puthash (substring file 0 (match-beginning 0)) t tbl)
    5128           0 :           (puthash file nil tbl)
    5129           0 :           (if (string-match ";[0-9]+\\'" file) ; deal with extension
    5130             :               ;; sans extension
    5131           0 :               (puthash (substring file 0 (match-beginning 0)) nil tbl)))
    5132           0 :         (forward-line 1))
    5133             :       ;; Would like to look for a "Total" line, or a "Directory" line to
    5134             :       ;; make sure that the listing isn't complete garbage before putting
    5135             :       ;; in "." and "..", but we can't count on VMS giving us
    5136             :       ;; either of these.
    5137           0 :       (puthash "." t tbl)
    5138           0 :       (puthash ".." t tbl))
    5139           0 :     tbl))
    5140             : 
    5141             : (add-to-list 'ange-ftp-parse-list-func-alist
    5142             :              '(vms . ange-ftp-parse-vms-listing))
    5143             : 
    5144             : ;; This version only deletes file entries which have
    5145             : ;; explicit version numbers, because that is all VMS allows.
    5146             : 
    5147             : ;; Can the following two functions be speeded up using file
    5148             : ;; completion functions?
    5149             : 
    5150             : (defun ange-ftp-vms-delete-file-entry (name &optional dir-p)
    5151           0 :   (if dir-p
    5152           0 :       (ange-ftp-internal-delete-file-entry name t)
    5153           0 :     (save-match-data
    5154           0 :       (let ((file (ange-ftp-get-file-part name)))
    5155           0 :         (if (string-match ";[0-9]+\\'" file)
    5156             :             ;; In VMS you can't delete a file without an explicit
    5157             :             ;; version number, or wild-card (e.g. FOO;*)
    5158             :             ;; For now, we give up on wildcards.
    5159           0 :             (let ((files (gethash (file-name-directory name)
    5160           0 :                                   ange-ftp-files-hashtable)))
    5161           0 :               (if files
    5162           0 :                   (let* ((root (substring file 0
    5163           0 :                                           (match-beginning 0)))
    5164           0 :                          (regexp (concat "^"
    5165           0 :                                          (regexp-quote root)
    5166           0 :                                          ";[0-9]+$"))
    5167             :                          versions)
    5168           0 :                     (remhash file files)
    5169             :                     ;; Now we need to check if there are any
    5170             :                     ;; versions left. If not, then delete the
    5171             :                     ;; root entry.
    5172           0 :                     (maphash
    5173             :                      (lambda (key _val)
    5174           0 :                        (and (string-match regexp key)
    5175           0 :                             (setq versions t)))
    5176           0 :                      files)
    5177           0 :                     (or versions
    5178           0 :                         (remhash root files))))))))))
    5179             : 
    5180             : (or (assq 'vms ange-ftp-delete-file-entry-alist)
    5181             :     (setq ange-ftp-delete-file-entry-alist
    5182             :           (cons '(vms . ange-ftp-vms-delete-file-entry)
    5183             :                 ange-ftp-delete-file-entry-alist)))
    5184             : 
    5185             : (defun ange-ftp-vms-add-file-entry (name &optional dir-p)
    5186           0 :   (if dir-p
    5187           0 :       (ange-ftp-internal-add-file-entry name t)
    5188           0 :     (let ((files (gethash (file-name-directory name)
    5189           0 :                           ange-ftp-files-hashtable)))
    5190           0 :       (if files
    5191           0 :           (let ((file (ange-ftp-get-file-part name)))
    5192           0 :             (save-match-data
    5193           0 :               (if (string-match ";[0-9]+\\'" file)
    5194           0 :                   (puthash (substring file 0 (match-beginning 0)) nil files)
    5195             :                 ;; Need to figure out what version of the file
    5196             :                 ;; is being added.
    5197           0 :                 (let ((regexp (concat "^"
    5198           0 :                                       (regexp-quote file)
    5199           0 :                                       ";\\([0-9]+\\)$"))
    5200             :                       (version 0))
    5201           0 :                   (maphash
    5202             :                    (lambda (name val)
    5203           0 :                      (and (string-match regexp name)
    5204           0 :                           (setq version
    5205           0 :                                 (max version
    5206           0 :                                      (string-to-number (match-string 1 name))))))
    5207           0 :                    files)
    5208           0 :                   (setq version (1+ version))
    5209           0 :                   (puthash
    5210           0 :                    (concat file ";" (int-to-string version))
    5211           0 :                    nil files))))
    5212           0 :             (puthash file nil files))))))
    5213             : 
    5214             : (or (assq 'vms ange-ftp-add-file-entry-alist)
    5215             :     (setq ange-ftp-add-file-entry-alist
    5216             :           (cons '(vms . ange-ftp-vms-add-file-entry)
    5217             :                 ange-ftp-add-file-entry-alist)))
    5218             : 
    5219             : 
    5220             : (defun ange-ftp-add-vms-host (host)
    5221             :   "Mark HOST as the name of a machine running VMS."
    5222             :   (interactive
    5223           0 :    (list (read-string "Host: "
    5224           0 :                       (let ((name (or (buffer-file-name) default-directory)))
    5225           0 :                         (and name (car (ange-ftp-ftp-name name)))))))
    5226           0 :   (if (not (ange-ftp-vms-host host))
    5227           0 :       (setq ange-ftp-vms-host-regexp
    5228           0 :             (concat "^" (regexp-quote host) "$"
    5229           0 :                     (and ange-ftp-vms-host-regexp "\\|")
    5230           0 :                     ange-ftp-vms-host-regexp)
    5231           0 :             ange-ftp-host-cache nil)))
    5232             : 
    5233             : 
    5234             : (defun ange-ftp-vms-file-name-as-directory (name)
    5235           0 :   (save-match-data
    5236           0 :     (if (string-match "\\.\\(DIR\\|dir\\)\\(;[0-9]+\\)?\\'" name)
    5237           0 :         (setq name (substring name 0 (match-beginning 0))))
    5238           0 :     (ange-ftp-real-file-name-as-directory name)))
    5239             : 
    5240             : (or (assq 'vms ange-ftp-file-name-as-directory-alist)
    5241             :     (setq ange-ftp-file-name-as-directory-alist
    5242             :           (cons '(vms . ange-ftp-vms-file-name-as-directory)
    5243             :                 ange-ftp-file-name-as-directory-alist)))
    5244             : 
    5245             : ;;; Tree dired support:
    5246             : 
    5247             : ;; For this code I have borrowed liberally from Sebastian Kremer's
    5248             : ;; dired-vms.el
    5249             : 
    5250             : 
    5251             : ;;;; These regexps must be anchored to beginning of line.
    5252             : ;;;; Beware that the ftpd may put the device in front of the filename.
    5253             : 
    5254             : ;;(defconst ange-ftp-dired-vms-re-exe "^. [^ \t.]+\\.\\(EXE\\|exe\\)[; ]"
    5255             : ;;  "Regular expression to use to search for VMS executable files.")
    5256             : 
    5257             : ;;(defconst ange-ftp-dired-vms-re-dir "^. [^ \t.]+\\.\\(DIR\\|dir\\)[; ]"
    5258             : ;;  "Regular expression to use to search for VMS directories.")
    5259             : 
    5260             : ;;(or (assq 'vms ange-ftp-dired-re-exe-alist)
    5261             : ;;    (setq ange-ftp-dired-re-exe-alist
    5262             : ;;        (cons (cons 'vms  ange-ftp-dired-vms-re-exe)
    5263             : ;;              ange-ftp-dired-re-exe-alist)))
    5264             : 
    5265             : ;;(or (assq 'vms ange-ftp-dired-re-dir-alist)
    5266             : ;;    (setq ange-ftp-dired-re-dir-alist
    5267             : ;;        (cons (cons 'vms  ange-ftp-dired-vms-re-dir)
    5268             : ;;              ange-ftp-dired-re-dir-alist)))
    5269             : 
    5270             : ;;(defun ange-ftp-dired-vms-insert-headerline (dir)
    5271             : ;;  ;; VMS inserts a headerline. I would prefer the headerline
    5272             : ;;  ;; to be in ange-ftp format. This version tries to
    5273             : ;;  ;; be careful, because we can't count on a headerline
    5274             : ;;  ;; over ftp, and we wouldn't want to delete anything
    5275             : ;;  ;; important.
    5276             : ;;  (save-excursion
    5277             : ;;    (if (looking-at "^  wildcard ")
    5278             : ;;      (forward-line 1))
    5279             : ;;    (if (looking-at "^[ \n\t]*[^\n]+\\][ \t]*\n")
    5280             : ;;      (delete-region (point) (match-end 0))))
    5281             : ;;  (ange-ftp-real-dired-insert-headerline dir))
    5282             : 
    5283             : ;;(or (assq 'vms ange-ftp-dired-insert-headerline-alist)
    5284             : ;;    (setq ange-ftp-dired-insert-headerline-alist
    5285             : ;;        (cons '(vms . ange-ftp-dired-vms-insert-headerline)
    5286             : ;;              ange-ftp-dired-insert-headerline-alist)))
    5287             : 
    5288             : ;;(defun ange-ftp-dired-vms-move-to-filename (&optional raise-error eol)
    5289             : ;;  "In dired, move to first char of filename on this line.
    5290             : ;;Returns position (point) or nil if no filename on this line."
    5291             : ;;  ;; This is the VMS version.
    5292             : ;;  (let (case-fold-search)
    5293             : ;;    (or eol (setq eol (progn (end-of-line) (point))))
    5294             : ;;    (beginning-of-line)
    5295             : ;;    (if (re-search-forward ange-ftp-vms-filename-regexp eol t)
    5296             : ;;      (goto-char (match-beginning 1))
    5297             : ;;      (if raise-error
    5298             : ;;        (error "No file on this line")
    5299             : ;;      nil))))
    5300             : 
    5301             : ;;(or (assq 'vms ange-ftp-dired-move-to-filename-alist)
    5302             : ;;    (setq ange-ftp-dired-move-to-filename-alist
    5303             : ;;        (cons '(vms . ange-ftp-dired-vms-move-to-filename)
    5304             : ;;              ange-ftp-dired-move-to-filename-alist)))
    5305             : 
    5306             : ;;(defun ange-ftp-dired-vms-move-to-end-of-filename (&optional no-error eol)
    5307             : ;;  ;; Assumes point is at beginning of filename.
    5308             : ;;  ;; So, it should be called only after (dired-move-to-filename t).
    5309             : ;;  ;; case-fold-search must be nil, at least for VMS.
    5310             : ;;  ;; On failure, signals an error or returns nil.
    5311             : ;;  ;; This is the VMS version.
    5312             : ;;  (let (opoint hidden case-fold-search)
    5313             : ;;    (setq opoint (point))
    5314             : ;;    (or eol (setq eol (line-end-position)))
    5315             : ;;    (setq hidden (and selective-display
    5316             : ;;                    (save-excursion (search-forward "\r" eol t))))
    5317             : ;;    (if hidden
    5318             : ;;      nil
    5319             : ;;      (re-search-forward ange-ftp-vms-filename-regexp eol t))
    5320             : ;;    (or no-error
    5321             : ;;      (not (eq opoint (point)))
    5322             : ;;      (error
    5323             : ;;       (if hidden
    5324             : ;;           (substitute-command-keys
    5325             : ;;            "File line is hidden, type \\[dired-hide-subdir] to unhide")
    5326             : ;;         "No file on this line")))
    5327             : ;;    (if (eq opoint (point))
    5328             : ;;      nil
    5329             : ;;      (point))))
    5330             : 
    5331             : ;;(or (assq 'vms ange-ftp-dired-move-to-end-of-filename-alist)
    5332             : ;;    (setq ange-ftp-dired-move-to-end-of-filename-alist
    5333             : ;;        (cons '(vms . ange-ftp-dired-vms-move-to-end-of-filename)
    5334             : ;;              ange-ftp-dired-move-to-end-of-filename-alist)))
    5335             : 
    5336             : ;;(defun ange-ftp-dired-vms-between-files ()
    5337             : ;;  (save-excursion
    5338             : ;;    (beginning-of-line)
    5339             : ;;    (or (equal (following-char) 10) ; newline
    5340             : ;;     (equal (following-char) 9)     ; tab
    5341             : ;;     (progn (forward-char 2)
    5342             : ;;          (or (looking-at "Total of")
    5343             : ;;              (equal (following-char) 32))))))
    5344             : 
    5345             : ;;(or (assq 'vms ange-ftp-dired-between-files-alist)
    5346             : ;;    (setq ange-ftp-dired-between-files-alist
    5347             : ;;        (cons '(vms . ange-ftp-dired-vms-between-files)
    5348             : ;;              ange-ftp-dired-between-files-alist)))
    5349             : 
    5350             : ;; Beware! In VMS filenames must be of the form "FILE.TYPE".
    5351             : ;; Therefore, we cannot just append a ".Z" to filenames for
    5352             : ;; compressed files. Instead, we turn "FILE.TYPE" into
    5353             : ;; "FILE.TYPE-Z". Hope that this is a reasonable thing to do.
    5354             : 
    5355             : (defun ange-ftp-vms-make-compressed-filename (name &optional _reverse)
    5356           0 :   (cond
    5357           0 :    ((string-match "-Z;[0-9]+\\'" name)
    5358           0 :     (list nil (substring name 0 (match-beginning 0))))
    5359           0 :    ((string-match ";[0-9]+\\'" name)
    5360           0 :     (list nil (substring name 0 (match-beginning 0))))
    5361           0 :    ((string-match "-Z\\'" name)
    5362           0 :     (list nil (substring name 0 -2)))
    5363             :    (t
    5364           0 :     (list t
    5365           0 :           (if (string-match ";[0-9]+\\'" name)
    5366           0 :               (concat (substring name 0 (match-beginning 0))
    5367           0 :                       "-Z")
    5368           0 :             (concat name "-Z"))))))
    5369             : 
    5370             : (or (assq 'vms ange-ftp-make-compressed-filename-alist)
    5371             :     (setq ange-ftp-make-compressed-filename-alist
    5372             :           (cons '(vms . ange-ftp-vms-make-compressed-filename)
    5373             :                 ange-ftp-make-compressed-filename-alist)))
    5374             : 
    5375             : ;;;; When the filename is too long, VMS will use two lines to list a file
    5376             : ;;;; (damn them!) This will confuse dired. To solve this, need to convince
    5377             : ;;;; Sebastian to use a function dired-go-to-end-of-file-line, instead of
    5378             : ;;;; (forward-line 1). This would require a number of changes to dired.el.
    5379             : ;;;; If dired gets confused, revert-buffer will fix it.
    5380             : 
    5381             : ;;(defun ange-ftp-dired-vms-ls-trim ()
    5382             : ;;  (goto-char (point-min))
    5383             : ;;  (let ((case-fold-search nil))
    5384             : ;;    (re-search-forward  ange-ftp-vms-filename-regexp))
    5385             : ;;  (beginning-of-line)
    5386             : ;;  (delete-region (point-min) (point))
    5387             : ;;  (forward-line 1)
    5388             : ;;  (delete-region (point) (point-max)))
    5389             : 
    5390             : 
    5391             : ;;(or (assq 'vms ange-ftp-dired-ls-trim-alist)
    5392             : ;;    (setq ange-ftp-dired-ls-trim-alist
    5393             : ;;        (cons '(vms . ange-ftp-dired-vms-ls-trim)
    5394             : ;;              ange-ftp-dired-ls-trim-alist)))
    5395             : 
    5396             : (defun ange-ftp-vms-sans-version (name &rest _args)
    5397           0 :   (save-match-data
    5398           0 :     (if (string-match ";[0-9]+\\'" name)
    5399           0 :         (substring name 0 (match-beginning 0))
    5400           0 :       name)))
    5401             : 
    5402             : (or (assq 'vms ange-ftp-sans-version-alist)
    5403             :     (setq ange-ftp-sans-version-alist
    5404             :           (cons '(vms . ange-ftp-vms-sans-version)
    5405             :                 ange-ftp-sans-version-alist)))
    5406             : 
    5407             : ;;(defvar ange-ftp-file-version-alist)
    5408             : 
    5409             : ;;;;; The vms version of clean-directory has 2 more optional args
    5410             : ;;;;; than the usual dired version. This is so that it can be used by
    5411             : ;;;;; ange-ftp-dired-vms-flag-backup-files.
    5412             : 
    5413             : ;;(defun ange-ftp-dired-vms-clean-directory (keep &optional marker msg)
    5414             : ;;  "Flag numerical backups for deletion.
    5415             : ;;Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
    5416             : ;;Positive prefix arg KEEP overrides `dired-kept-versions';
    5417             : ;;Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive.
    5418             : 
    5419             : ;;To clear the flags on these files, you can use \\[dired-flag-backup-files]
    5420             : ;;with a prefix argument."
    5421             : ;;;  (interactive "P") ; Never actually called interactively.
    5422             : ;;  (setq keep (max 1 (if keep (prefix-numeric-value keep) dired-kept-versions)))
    5423             : ;;  (let ((early-retention (if (< keep 0) (- keep) kept-old-versions))
    5424             : ;;      ;; late-retention must NEVER be allowed to be less than 1 in VMS!
    5425             : ;;      ;; This could wipe ALL copies of the file.
    5426             : ;;      (late-retention (max 1 (if (<= keep 0) dired-kept-versions keep)))
    5427             : ;;      (action (or msg "Cleaning"))
    5428             : ;;      (ange-ftp-trample-marker (or marker dired-del-marker))
    5429             : ;;      (ange-ftp-file-version-alist ()))
    5430             : ;;    (message (concat action
    5431             : ;;                   " numerical backups (keeping %d late, %d old)...")
    5432             : ;;           late-retention early-retention)
    5433             : ;;    ;; Look at each file.
    5434             : ;;    ;; If the file has numeric backup versions,
    5435             : ;;    ;; put on ange-ftp-file-version-alist an element of the form
    5436             : ;;    ;; (FILENAME . VERSION-NUMBER-LIST)
    5437             : ;;    (dired-map-dired-file-lines 'ange-ftp-dired-vms-collect-file-versions)
    5438             : ;;    ;; Sort each VERSION-NUMBER-LIST,
    5439             : ;;    ;; and remove the versions not to be deleted.
    5440             : ;;    (let ((fval ange-ftp-file-version-alist))
    5441             : ;;      (while fval
    5442             : ;;      (let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
    5443             : ;;             (v-count (length sorted-v-list)))
    5444             : ;;        (if (> v-count (+ early-retention late-retention))
    5445             : ;;            (rplacd (nthcdr early-retention sorted-v-list)
    5446             : ;;                    (nthcdr (- v-count late-retention)
    5447             : ;;                            sorted-v-list)))
    5448             : ;;        (rplacd (car fval)
    5449             : ;;                (cdr sorted-v-list)))
    5450             : ;;      (setq fval (cdr fval))))
    5451             : ;;    ;; Look at each file.  If it is a numeric backup file,
    5452             : ;;    ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
    5453             : ;;    (dired-map-dired-file-lines
    5454             : ;;     'ange-ftp-dired-vms-trample-file-versions mark)
    5455             : ;;    (message (concat action " numerical backups...done"))))
    5456             : 
    5457             : ;;(or (assq 'vms ange-ftp-dired-clean-directory-alist)
    5458             : ;;    (setq ange-ftp-dired-clean-directory-alist
    5459             : ;;        (cons '(vms . ange-ftp-dired-vms-clean-directory)
    5460             : ;;              ange-ftp-dired-clean-directory-alist)))
    5461             : 
    5462             : ;;(defun ange-ftp-dired-vms-collect-file-versions (fn)
    5463             : ;;  ;;  "If it looks like file FN has versions, return a list of the versions.
    5464             : ;;  ;;That is a list of strings which are file names.
    5465             : ;;  ;;The caller may want to flag some of these files for deletion."
    5466             : ;;(let ((name (nth 2 (ange-ftp-ftp-name fn))))
    5467             : ;;  (if (string-match ";[0-9]+$" name)
    5468             : ;;      (let* ((name (substring name 0 (match-beginning 0)))
    5469             : ;;           (fn (ange-ftp-replace-name-component fn name)))
    5470             : ;;      (if (not (assq fn ange-ftp-file-version-alist))
    5471             : ;;          (let* ((base-versions
    5472             : ;;                  (concat (file-name-nondirectory name) ";"))
    5473             : ;;                 (bv-length (length base-versions))
    5474             : ;;                 (possibilities (file-name-all-completions
    5475             : ;;                                 base-versions
    5476             : ;;                                 (file-name-directory fn)))
    5477             : ;;                 (versions (mapcar
    5478             : ;;                            (lambda (arg)
    5479             : ;;                               (if (and (string-match
    5480             : ;;                                         "[0-9]+$" arg bv-length)
    5481             : ;;                                        (= (match-beginning 0) bv-length))
    5482             : ;;                                   (string-to-int (substring arg bv-length))
    5483             : ;;                                 0))
    5484             : ;;                            possibilities)))
    5485             : ;;            (if versions
    5486             : ;;                (setq
    5487             : ;;                 ange-ftp-file-version-alist
    5488             : ;;                 (cons (cons fn versions)
    5489             : ;;                       ange-ftp-file-version-alist)))))))))
    5490             : 
    5491             : ;;(defun ange-ftp-dired-vms-trample-file-versions (fn)
    5492             : ;;  (let* ((start-vn (string-match ";[0-9]+$" fn))
    5493             : ;;       base-version-list)
    5494             : ;;    (and start-vn
    5495             : ;;       (setq base-version-list        ; there was a base version to which
    5496             : ;;             (assoc (substring fn 0 start-vn) ; this looks like a
    5497             : ;;                    ange-ftp-file-version-alist))     ; subversion
    5498             : ;;       (not (memq (string-to-int (substring fn (1+ start-vn)))
    5499             : ;;                  base-version-list)) ; this one doesn't make the cut
    5500             : ;;       (progn (beginning-of-line)
    5501             : ;;              (delete-char 1)
    5502             : ;;              (insert ange-ftp-trample-marker)))))
    5503             : 
    5504             : ;;(defun ange-ftp-dired-vms-flag-backup-files (&optional unflag-p)
    5505             : ;;  (let ((dired-kept-versions 1)
    5506             : ;;      (kept-old-versions 0)
    5507             : ;;      marker msg)
    5508             : ;;    (if unflag-p
    5509             : ;;      (setq marker ?\040 msg "Unflagging")
    5510             : ;;      (setq marker dired-del-marker msg "Cleaning"))
    5511             : ;;    (ange-ftp-dired-vms-clean-directory nil marker msg)))
    5512             : 
    5513             : ;;(or (assq 'vms ange-ftp-dired-flag-backup-files-alist)
    5514             : ;;    (setq ange-ftp-dired-flag-backup-files-alist
    5515             : ;;        (cons '(vms . ange-ftp-dired-vms-flag-backup-files)
    5516             : ;;              ange-ftp-dired-flag-backup-files-alist)))
    5517             : 
    5518             : ;;(defun ange-ftp-dired-vms-backup-diff (&optional switches)
    5519             : ;;  (let ((file (dired-get-filename 'no-dir))
    5520             : ;;      bak)
    5521             : ;;    (if (and (string-match ";[0-9]+$" file)
    5522             : ;;           ;; Find most recent previous version.
    5523             : ;;           (let ((root (substring file 0 (match-beginning 0)))
    5524             : ;;                 (ver
    5525             : ;;                  (string-to-int (substring file (1+ (match-beginning 0)))))
    5526             : ;;                 found)
    5527             : ;;             (setq ver (1- ver))
    5528             : ;;             (while (and (> ver 0) (not found))
    5529             : ;;               (setq bak (concat root ";" (int-to-string ver)))
    5530             : ;;               (and (file-exists-p bak) (setq found t))
    5531             : ;;               (setq ver (1- ver)))
    5532             : ;;             found))
    5533             : ;;      (if switches
    5534             : ;;          (diff (expand-file-name bak) (expand-file-name file) switches)
    5535             : ;;        (diff (expand-file-name bak) (expand-file-name file)))
    5536             : ;;      (error "No previous version found for %s" file))))
    5537             : 
    5538             : ;;(or (assq 'vms ange-ftp-dired-backup-diff-alist)
    5539             : ;;    (setq ange-ftp-dired-backup-diff-alist
    5540             : ;;        (cons '(vms . ange-ftp-dired-vms-backup-diff)
    5541             : ;;              ange-ftp-dired-backup-diff-alist)))
    5542             : 
    5543             : 
    5544             : ;;;; ------------------------------------------------------------
    5545             : ;;;; MTS support
    5546             : ;;;; ------------------------------------------------------------
    5547             : 
    5548             : 
    5549             : ;; Convert NAME from UNIX-ish to MTS. If REVERSE given then convert from
    5550             : ;; MTS to UNIX-ish.
    5551             : (defun ange-ftp-fix-name-for-mts (name &optional reverse)
    5552           0 :   (save-match-data
    5553           0 :     (if reverse
    5554           0 :         (if (string-match "\\`\\([^:]+:\\)?\\(.*\\)\\'" name)
    5555           0 :             (let (acct file)
    5556           0 :               (setq acct (match-string 1 name))
    5557           0 :               (setq file (match-string 2 name))
    5558           0 :               (concat (and acct (concat "/" acct "/"))
    5559           0 :                       file))
    5560           0 :           (error "name %s didn't match" name))
    5561           0 :       (if (string-match "\\`/\\([^:]+:\\)/\\(.*\\)\\'" name)
    5562           0 :           (concat (match-string 1 name) (match-string 2 name))
    5563             :         ;; Let's hope that mts will recognize it anyway.
    5564           0 :         name))))
    5565             : 
    5566             : (or (assq 'mts ange-ftp-fix-name-func-alist)
    5567             :     (setq ange-ftp-fix-name-func-alist
    5568             :           (cons '(mts . ange-ftp-fix-name-for-mts)
    5569             :                 ange-ftp-fix-name-func-alist)))
    5570             : 
    5571             : ;; Convert name from UNIX-ish to MTS ready for a DIRectory listing.
    5572             : ;; Remember that there are no directories in MTS.
    5573             : (defun ange-ftp-fix-dir-name-for-mts (dir-name)
    5574           0 :   (if (string-equal dir-name "/")
    5575           0 :       (error "Cannot get listing for fictitious \"/\" directory")
    5576           0 :     (let ((dir-name (ange-ftp-fix-name-for-mts dir-name)))
    5577           0 :       (cond
    5578           0 :        ((string-equal dir-name "")
    5579             :         "?")
    5580           0 :        ((string-match ":\\'" dir-name)
    5581           0 :         (concat dir-name "?"))
    5582           0 :        (dir-name))))) ; It's just a single file.
    5583             : 
    5584             : (or (assq 'mts ange-ftp-fix-dir-name-func-alist)
    5585             :     (setq ange-ftp-fix-dir-name-func-alist
    5586             :           (cons '(mts . ange-ftp-fix-dir-name-for-mts)
    5587             :                 ange-ftp-fix-dir-name-func-alist)))
    5588             : 
    5589             : (or (memq 'mts ange-ftp-dumb-host-types)
    5590             :     (setq ange-ftp-dumb-host-types
    5591             :           (cons 'mts ange-ftp-dumb-host-types)))
    5592             : 
    5593             : (defvar ange-ftp-mts-host-regexp nil)
    5594             : 
    5595             : ;; Return non-nil if HOST is running MTS.
    5596             : (defun ange-ftp-mts-host (host)
    5597           0 :   (and ange-ftp-mts-host-regexp
    5598           0 :        (string-match-p ange-ftp-mts-host-regexp host)))
    5599             : 
    5600             : ;; Parse the current buffer which is assumed to be in mts ftp dir format.
    5601             : (defun ange-ftp-parse-mts-listing ()
    5602           0 :   (let ((tbl (make-hash-table :test 'equal)))
    5603           0 :     (goto-char (point-min))
    5604           0 :     (save-match-data
    5605           0 :       (while (re-search-forward directory-listing-before-filename-regexp nil t)
    5606           0 :         (end-of-line)
    5607           0 :         (skip-chars-backward " ")
    5608           0 :         (let ((end (point)))
    5609           0 :           (skip-chars-backward "-A-Z0-9_.!")
    5610           0 :           (puthash (buffer-substring (point) end) nil tbl))
    5611           0 :         (forward-line 1)))
    5612             :     ;; Don't need to bother with ..
    5613           0 :     (puthash "." t tbl)
    5614           0 :     tbl))
    5615             : 
    5616             : (add-to-list 'ange-ftp-parse-list-func-alist
    5617             :              '(mts . ange-ftp-parse-mts-listing))
    5618             : 
    5619             : (defun ange-ftp-add-mts-host (host)
    5620             :   "Mark HOST as the name of a machine running MTS."
    5621             :   (interactive
    5622           0 :    (list (read-string "Host: "
    5623           0 :                       (let ((name (or (buffer-file-name) default-directory)))
    5624           0 :                         (and name (car (ange-ftp-ftp-name name)))))))
    5625           0 :   (if (not (ange-ftp-mts-host host))
    5626           0 :       (setq ange-ftp-mts-host-regexp
    5627           0 :             (concat "^" (regexp-quote host) "$"
    5628           0 :                     (and ange-ftp-mts-host-regexp "\\|")
    5629           0 :                     ange-ftp-mts-host-regexp)
    5630           0 :             ange-ftp-host-cache nil)))
    5631             : 
    5632             : ;;; Tree dired support:
    5633             : 
    5634             : ;;;; There aren't too many systems left that use MTS. This dired support will
    5635             : ;;;; work for the implementation of ftp on mtsg.ubc.ca. I hope other mts systems
    5636             : ;;;; implement ftp in the same way. If not, it might be necessary to make the
    5637             : ;;;; following more flexible.
    5638             : 
    5639             : ;;(defun ange-ftp-dired-mts-move-to-filename (&optional raise-error eol)
    5640             : ;;  "In dired, move to first char of filename on this line.
    5641             : ;;Returns position (point) or nil if no filename on this line."
    5642             : ;;  ;; This is the MTS version.
    5643             : ;;  (or eol (setq eol (progn (end-of-line) (point))))
    5644             : ;;  (beginning-of-line)
    5645             : ;;  (if (re-search-forward
    5646             : ;;       ange-ftp-date-regexp eol t)
    5647             : ;;      (progn
    5648             : ;;      (skip-chars-forward " ")          ; Eat blanks after date
    5649             : ;;      (skip-chars-forward "0-9:" eol)   ; Eat time or year
    5650             : ;;      (skip-chars-forward " " eol)      ; one space before filename
    5651             : ;;      ;; When listing an account other than the users own account it appends
    5652             : ;;      ;; ACCT: to the beginning of the filename. Skip over this.
    5653             : ;;      (and (looking-at "[A-Z0-9_.]+:")
    5654             : ;;           (goto-char (match-end 0)))
    5655             : ;;      (point))
    5656             : ;;    (if raise-error
    5657             : ;;      (error "No file on this line")
    5658             : ;;      nil)))
    5659             : 
    5660             : ;;(or (assq 'mts ange-ftp-dired-move-to-filename-alist)
    5661             : ;;    (setq ange-ftp-dired-move-to-filename-alist
    5662             : ;;        (cons '(mts . ange-ftp-dired-mts-move-to-filename)
    5663             : ;;              ange-ftp-dired-move-to-filename-alist)))
    5664             : 
    5665             : ;;(defun ange-ftp-dired-mts-move-to-end-of-filename (&optional no-error eol)
    5666             : ;;  ;; Assumes point is at beginning of filename.
    5667             : ;;  ;; So, it should be called only after (dired-move-to-filename t).
    5668             : ;;  ;; On failure, signals an error or returns nil.
    5669             : ;;  ;; This is the MTS version.
    5670             : ;;  (let (opoint hidden case-fold-search)
    5671             : ;;    (setq opoint (point)
    5672             : ;;        eol (line-end-position)
    5673             : ;;        hidden (and selective-display
    5674             : ;;                    (save-excursion (search-forward "\r" eol t))))
    5675             : ;;    (if hidden
    5676             : ;;      nil
    5677             : ;;      (skip-chars-forward "-A-Z0-9._!" eol))
    5678             : ;;    (or no-error
    5679             : ;;      (not (eq opoint (point)))
    5680             : ;;      (error
    5681             : ;;       (if hidden
    5682             : ;;           (substitute-command-keys
    5683             : ;;            "File line is hidden, type \\[dired-hide-subdir] to unhide")
    5684             : ;;         "No file on this line")))
    5685             : ;;    (if (eq opoint (point))
    5686             : ;;      nil
    5687             : ;;      (point))))
    5688             : 
    5689             : ;;(or (assq 'mts ange-ftp-dired-move-to-end-of-filename-alist)
    5690             : ;;    (setq ange-ftp-dired-move-to-end-of-filename-alist
    5691             : ;;        (cons '(mts . ange-ftp-dired-mts-move-to-end-of-filename)
    5692             : ;;              ange-ftp-dired-move-to-end-of-filename-alist)))
    5693             : 
    5694             : ;;;; ------------------------------------------------------------
    5695             : ;;;; CMS support
    5696             : ;;;; ------------------------------------------------------------
    5697             : 
    5698             : ;; Since CMS doesn't have any full file name syntax, we have to fudge
    5699             : ;; things with cd's. We actually send too many cd's, but it's dangerous
    5700             : ;; to try to remember the current minidisk, because if the connection
    5701             : ;; is closed and needs to be reopened, we will find ourselves back in
    5702             : ;; the default minidisk. This is fairly likely since CMS ftp servers
    5703             : ;; usually close the connection after 5 minutes of inactivity.
    5704             : 
    5705             : ;; Have I got the filename character set right?
    5706             : 
    5707             : (defun ange-ftp-fix-name-for-cms (name &optional reverse)
    5708           0 :   (save-match-data
    5709           0 :     (if reverse
    5710             :         ;; Since we only convert output from a pwd in this direction,
    5711             :         ;; we'll assume that it's a minidisk, and make it into a
    5712             :         ;; directory file name. Note that the expand-dir-hashtable
    5713             :         ;; stores directories without the trailing /. Is this
    5714             :         ;; consistent?
    5715           0 :         (concat "/" name)
    5716           0 :       (if (string-match "\\`/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?\\'"
    5717           0 :                         name)
    5718           0 :           (let ((minidisk (match-string 1 name)))
    5719           0 :             (if (match-beginning 2)
    5720           0 :                 (let ((file (match-string 2 name))
    5721           0 :                       (cmd (concat "cd " minidisk))
    5722             : 
    5723             :                       ;; Note that host and user are bound in the call
    5724             :                       ;; to ange-ftp-send-cmd
    5725           0 :                       (proc (ange-ftp-get-process ange-ftp-this-host
    5726           0 :                                                   ange-ftp-this-user)))
    5727             : 
    5728             :                   ;; Must use ange-ftp-raw-send-cmd here to avoid
    5729             :                   ;; an infinite loop.
    5730           0 :                   (if (car (ange-ftp-raw-send-cmd proc cmd ange-ftp-this-msg))
    5731           0 :                       file
    5732             :                     ;; failed... try ONCE more.
    5733           0 :                     (setq proc (ange-ftp-get-process ange-ftp-this-host
    5734           0 :                                                      ange-ftp-this-user))
    5735           0 :                     (let ((result (ange-ftp-raw-send-cmd proc cmd
    5736           0 :                                                          ange-ftp-this-msg)))
    5737           0 :                       (if (car result)
    5738           0 :                           file
    5739             :                         ;; failed.  give up.
    5740           0 :                         (ange-ftp-error ange-ftp-this-host ange-ftp-this-user
    5741           0 :                                         (format "cd to minidisk %s failed: %s"
    5742           0 :                                                 minidisk (cdr result)))))))
    5743             :               ;; return the minidisk
    5744           0 :               minidisk))
    5745           0 :         (error "Invalid CMS filename")))))
    5746             : 
    5747             : (or (assq 'cms ange-ftp-fix-name-func-alist)
    5748             :     (setq ange-ftp-fix-name-func-alist
    5749             :           (cons '(cms . ange-ftp-fix-name-for-cms)
    5750             :                 ange-ftp-fix-name-func-alist)))
    5751             : 
    5752             : (or (memq 'cms ange-ftp-dumb-host-types)
    5753             :     (setq ange-ftp-dumb-host-types
    5754             :           (cons 'cms ange-ftp-dumb-host-types)))
    5755             : 
    5756             : ;; Convert name from UNIX-ish to CMS ready for a DIRectory listing.
    5757             : (defun ange-ftp-fix-dir-name-for-cms (dir-name)
    5758           0 :   (cond
    5759           0 :    ((string-equal "/" dir-name)
    5760           0 :     (error "Cannot get listing for fictitious \"/\" directory"))
    5761           0 :    ((string-match "\\`/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?\\'" dir-name)
    5762           0 :     (let* ((minidisk (match-string 1 dir-name))
    5763             :            ;; host and user are bound in the call to ange-ftp-send-cmd
    5764           0 :            (proc (ange-ftp-get-process ange-ftp-this-host ange-ftp-this-user))
    5765           0 :            (cmd (concat "cd " minidisk))
    5766           0 :            (file (if (match-beginning 2)
    5767             :                      ;; it's a single file
    5768           0 :                      (match-string 2 dir-name)
    5769             :                    ;; use the wild-card
    5770           0 :                    "*")))
    5771           0 :       (if (car (ange-ftp-raw-send-cmd proc cmd))
    5772           0 :           file
    5773             :         ;; try again...
    5774           0 :         (setq proc (ange-ftp-get-process ange-ftp-this-host
    5775           0 :                                          ange-ftp-this-user))
    5776           0 :         (let ((result (ange-ftp-raw-send-cmd proc cmd)))
    5777           0 :           (if (car result)
    5778           0 :               file
    5779             :             ;; give up
    5780           0 :             (ange-ftp-error ange-ftp-this-host ange-ftp-this-user
    5781           0 :                             (format "cd to minidisk %s failed: %s"
    5782           0 :                                     minidisk (cdr result))))))))
    5783           0 :    (t (error "Invalid CMS file name"))))
    5784             : 
    5785             : (or (assq 'cms ange-ftp-fix-dir-name-func-alist)
    5786             :     (setq ange-ftp-fix-dir-name-func-alist
    5787             :           (cons '(cms . ange-ftp-fix-dir-name-for-cms)
    5788             :                 ange-ftp-fix-dir-name-func-alist)))
    5789             : 
    5790             : (defvar ange-ftp-cms-host-regexp nil
    5791             :   "Regular expression to match hosts running the CMS operating system.")
    5792             : 
    5793             : ;; Return non-nil if HOST is running CMS.
    5794             : (defun ange-ftp-cms-host (host)
    5795           0 :   (and ange-ftp-cms-host-regexp
    5796           0 :        (string-match-p ange-ftp-cms-host-regexp host)))
    5797             : 
    5798             : (defun ange-ftp-add-cms-host (host)
    5799             :   "Mark HOST as the name of a CMS host."
    5800             :   (interactive
    5801           0 :    (list (read-string "Host: "
    5802           0 :                       (let ((name (or (buffer-file-name) default-directory)))
    5803           0 :                         (and name (car (ange-ftp-ftp-name name)))))))
    5804           0 :   (if (not (ange-ftp-cms-host host))
    5805           0 :       (setq ange-ftp-cms-host-regexp
    5806           0 :             (concat "^" (regexp-quote host) "$"
    5807           0 :                     (and ange-ftp-cms-host-regexp "\\|")
    5808           0 :                     ange-ftp-cms-host-regexp)
    5809           0 :             ange-ftp-host-cache nil)))
    5810             : 
    5811             : (defun ange-ftp-parse-cms-listing ()
    5812             :   ;; Parse the current buffer which is assumed to be a CMS directory listing.
    5813             :   ;; If we succeed in getting a listing, then we will assume that the minidisk
    5814             :   ;; exists. file is bound by the call to ange-ftp-ls. This doesn't work
    5815             :   ;; because ange-ftp doesn't know that the root hashtable has only part of
    5816             :   ;; the info. It will assume that if a minidisk isn't in it, then it doesn't
    5817             :   ;; exist. It would be nice if completion worked for minidisks, as we
    5818             :   ;; discover them.
    5819             : ;  (let* ((dir-file (directory-file-name file))
    5820             : ;        (root (file-name-directory dir-file))
    5821             : ;        (minidisk (ange-ftp-get-file-part dir-file))
    5822             : ;        (root-tbl (ange-ftp-get-hash-entry root ange-ftp-files-hashtable)))
    5823             : ;    (if root-tbl
    5824             : ;       (puthash minidisk t root-tbl)
    5825             : ;      (setq root-tbl (ange-ftp-make-hashtable))
    5826             : ;      (puthash minidisk t root-tbl)
    5827             : ;      (puthash "." t root-tbl)
    5828             : ;      (ange-ftp-set-files root root-tbl)))
    5829             :   ;; Now do the usual parsing
    5830           0 :   (let ((tbl (make-hash-table :test 'equal)))
    5831           0 :     (goto-char (point-min))
    5832           0 :     (save-match-data
    5833           0 :       (while
    5834           0 :           (re-search-forward
    5835           0 :            "^\\([-A-Z0-9$_]+\\) +\\([-A-Z0-9$_]+\\) +[VF] +[0-9]+ " nil t)
    5836           0 :         (puthash (concat (match-string 1) "." (match-string 2)) nil tbl)
    5837           0 :         (forward-line 1))
    5838           0 :       (puthash "." t tbl))
    5839           0 :     tbl))
    5840             : 
    5841             : (add-to-list 'ange-ftp-parse-list-func-alist
    5842             :              '(cms . ange-ftp-parse-cms-listing))
    5843             : 
    5844             : ;;;;; Tree dired support:
    5845             : 
    5846             : ;;(defconst ange-ftp-dired-cms-re-exe
    5847             : ;;  "^. [-A-Z0-9$_]+ +EXEC "
    5848             : ;;  "Regular expression to use to search for CMS executables.")
    5849             : 
    5850             : ;;(or (assq 'cms ange-ftp-dired-re-exe-alist)
    5851             : ;;    (setq ange-ftp-dired-re-exe-alist
    5852             : ;;        (cons (cons 'cms  ange-ftp-dired-cms-re-exe)
    5853             : ;;              ange-ftp-dired-re-exe-alist)))
    5854             : 
    5855             : 
    5856             : ;;(defun ange-ftp-dired-cms-insert-headerline (dir)
    5857             : ;;  ;; CMS has no total line, so we insert a blank line for
    5858             : ;;  ;; aesthetics.
    5859             : ;;  (insert "\n")
    5860             : ;;  (forward-char -1)
    5861             : ;;  (ange-ftp-real-dired-insert-headerline dir))
    5862             : 
    5863             : ;;(or (assq 'cms ange-ftp-dired-insert-headerline-alist)
    5864             : ;;    (setq ange-ftp-dired-insert-headerline-alist
    5865             : ;;        (cons '(cms . ange-ftp-dired-cms-insert-headerline)
    5866             : ;;              ange-ftp-dired-insert-headerline-alist)))
    5867             : 
    5868             : ;;(defun ange-ftp-dired-cms-move-to-filename (&optional raise-error eol)
    5869             : ;;  "In dired, move to the first char of filename on this line."
    5870             : ;;  ;; This is the CMS version.
    5871             : ;;  (or eol (setq eol (progn (end-of-line) (point))))
    5872             : ;;  (let (case-fold-search)
    5873             : ;;    (beginning-of-line)
    5874             : ;;    (if (re-search-forward " [-A-Z0-9$_]+ +[-A-Z0-9$_]+ +[VF] +[0-9]+ " eol t)
    5875             : ;;      (goto-char (1+ (match-beginning 0)))
    5876             : ;;      (if raise-error
    5877             : ;;        (error "No file on this line")
    5878             : ;;      nil))))
    5879             : 
    5880             : ;;(or (assq 'cms ange-ftp-dired-move-to-filename-alist)
    5881             : ;;    (setq ange-ftp-dired-move-to-filename-alist
    5882             : ;;        (cons '(cms . ange-ftp-dired-cms-move-to-filename)
    5883             : ;;              ange-ftp-dired-move-to-filename-alist)))
    5884             : 
    5885             : ;;(defun ange-ftp-dired-cms-move-to-end-of-filename (&optional no-error eol)
    5886             : ;;  ;; Assumes point is at beginning of filename.
    5887             : ;;  ;; So, it should be called only after (dired-move-to-filename t).
    5888             : ;;  ;; case-fold-search must be nil, at least for VMS.
    5889             : ;;  ;; On failure, signals an error or returns nil.
    5890             : ;;  ;; This is the CMS version.
    5891             : ;;  (let ((opoint (point))
    5892             : ;;      case-fold-search hidden)
    5893             : ;;    (or eol (setq eol (line-end-position)))
    5894             : ;;    (setq hidden (and selective-display
    5895             : ;;                    (save-excursion
    5896             : ;;                      (search-forward "\r" eol t))))
    5897             : ;;    (if hidden
    5898             : ;;      (if no-error
    5899             : ;;          nil
    5900             : ;;        (error
    5901             : ;;         (substitute-command-keys
    5902             : ;;          "File line is hidden, type \\[dired-hide-subdir] to unhide")))
    5903             : ;;      (skip-chars-forward "-A-Z0-9$_" eol)
    5904             : ;;      (skip-chars-forward " " eol)
    5905             : ;;      (skip-chars-forward "-A-Z0-9$_" eol)
    5906             : ;;      (if (eq opoint (point))
    5907             : ;;        (if no-error
    5908             : ;;            nil
    5909             : ;;          (error "No file on this line"))
    5910             : ;;      (point)))))
    5911             : 
    5912             : ;;(or (assq 'cms ange-ftp-dired-move-to-end-of-filename-alist)
    5913             : ;;    (setq ange-ftp-dired-move-to-end-of-filename-alist
    5914             : ;;        (cons '(cms . ange-ftp-dired-cms-move-to-end-of-filename)
    5915             : ;;              ange-ftp-dired-move-to-end-of-filename-alist)))
    5916             : 
    5917             : (defun ange-ftp-cms-make-compressed-filename (name &optional _reverse)
    5918           0 :   (if (string-match "-Z\\'" name)
    5919           0 :       (list nil (substring name 0 -2))
    5920           0 :     (list t (concat name "-Z"))))
    5921             : 
    5922             : (or (assq 'cms ange-ftp-make-compressed-filename-alist)
    5923             :     (setq ange-ftp-make-compressed-filename-alist
    5924             :           (cons '(cms . ange-ftp-cms-make-compressed-filename)
    5925             :                 ange-ftp-make-compressed-filename-alist)))
    5926             : 
    5927             : ;;(defun ange-ftp-dired-cms-get-filename (&optional localp no-error-if-not-filep)
    5928             : ;;  (let ((name (ange-ftp-real-dired-get-filename localp no-error-if-not-filep)))
    5929             : ;;    (and name
    5930             : ;;       (if (string-match "^\\([^ ]+\\) +\\([^ ]+\\)$" name)
    5931             : ;;           (concat (substring name 0 (match-end 1))
    5932             : ;;                   "."
    5933             : ;;                   (substring name (match-beginning 2) (match-end 2)))
    5934             : ;;         name))))
    5935             : 
    5936             : ;;(or (assq 'cms ange-ftp-dired-get-filename-alist)
    5937             : ;;    (setq ange-ftp-dired-get-filename-alist
    5938             : ;;        (cons '(cms . ange-ftp-dired-cms-get-filename)
    5939             : ;;              ange-ftp-dired-get-filename-alist)))
    5940             : 
    5941             : ;;;; ------------------------------------------------------------
    5942             : ;;;; BS2000 support
    5943             : ;;;; ------------------------------------------------------------
    5944             : 
    5945             : ;; There seems to be an error with regexps. '-' has to be the first
    5946             : ;; character inside of the square brackets.
    5947             : (defconst ange-ftp-bs2000-short-filename-regexp
    5948             :   "[-A-Z0-9$#@.]*[A-Z][-A-Z0-9$#@.]*"
    5949             :   "Regular expression to match for a valid short BS2000 file name.")
    5950             : 
    5951             : (defconst ange-ftp-bs2000-fix-name-regexp-reverse
    5952             :   (concat
    5953             :    "^\\(" ange-ftp-bs2000-filename-pubset-regexp "\\)?"
    5954             :    "\\(" ange-ftp-bs2000-filename-username-regexp "\\)?"
    5955             :    "\\(" ange-ftp-bs2000-short-filename-regexp "\\)?")
    5956             :   "Regular expression used in `ange-ftp-fix-name-for-bs2000'.")
    5957             : 
    5958             : (defconst ange-ftp-bs2000-fix-name-regexp
    5959             :   (concat
    5960             :    "/?\\(" ange-ftp-bs2000-filename-pubset-regexp "/\\)?"
    5961             :    "\\(\\$[A-Z0-9]*/\\)?"
    5962             :    "\\(" ange-ftp-bs2000-short-filename-regexp "\\)?")
    5963             :   "Regular expression used in `ange-ftp-fix-name-for-bs2000'.")
    5964             : 
    5965             : (defcustom ange-ftp-bs2000-special-prefix
    5966             :   "X"
    5967             :   "Prefix used for filenames starting with `#' or `@'."
    5968             :   :group 'ange-ftp
    5969             :   :type 'string)
    5970             : 
    5971             : ;; Convert NAME from UNIX-ish to BS2000. If REVERSE given then convert from
    5972             : ;; BS2000 to UNIX-ish.
    5973             : (defun ange-ftp-fix-name-for-bs2000 (name &optional reverse)
    5974           0 :   (save-match-data
    5975           0 :     (if reverse
    5976           0 :         (if (string-match
    5977           0 :              ange-ftp-bs2000-fix-name-regexp-reverse
    5978           0 :              name)
    5979           0 :             (let ((pubset (if (match-beginning 1)
    5980           0 :                               (substring name 0 (match-end 1))))
    5981           0 :                   (userid (if (match-beginning 2)
    5982           0 :                               (substring name
    5983           0 :                                          (match-beginning 2)
    5984           0 :                                          (1- (match-end 2)))))
    5985           0 :                   (filename (if (match-beginning 3)
    5986           0 :                                 (substring name (match-beginning 3)))))
    5987           0 :               (concat
    5988             :                "/"
    5989             :                ;; we have to insert "_/" here to prevent expand-file-name to
    5990             :                ;; interpret BS2000 pubsets as the special escape prefix:
    5991           0 :                (and pubset (concat "_/" pubset "/"))
    5992           0 :                (and userid (concat userid "/"))
    5993           0 :                filename))
    5994           0 :           (error "name %s didn't match" name))
    5995             :       ;; and here we (maybe) have to remove the inserted "_/" 'cause
    5996             :       ;; of our prevention of the special escape prefix above:
    5997           0 :       (if (string-match (concat "^/_/") name)
    5998           0 :           (setq name (substring name 2)))
    5999           0 :       (if (string-match
    6000           0 :            ange-ftp-bs2000-fix-name-regexp
    6001           0 :            name)
    6002           0 :           (let ((pubset (if (match-beginning 1)
    6003           0 :                             (substring name
    6004           0 :                                        (match-beginning 1)
    6005           0 :                                        (1- (match-end 1)))))
    6006           0 :                 (userid (if (match-beginning 2)
    6007           0 :                             (substring name
    6008           0 :                                        (match-beginning 2)
    6009           0 :                                        (1- (match-end 2)))))
    6010           0 :                 (filename (if (match-beginning 3)
    6011           0 :                               (substring name (match-beginning 3)))))
    6012           0 :             (if (and (boundp 'filename)
    6013           0 :                      (stringp filename)
    6014           0 :                      (string-match "[#@].+" filename))
    6015           0 :                 (setq filename (concat ange-ftp-bs2000-special-prefix
    6016           0 :                                        (substring filename 1))))
    6017           0 :             (upcase
    6018           0 :              (concat
    6019           0 :               pubset
    6020           0 :               (and userid (concat userid "."))
    6021             :               ;; change every '/' in filename to a '.', normally not necessary
    6022           0 :               (and filename
    6023           0 :                    (subst-char-in-string ?/ ?. filename)))))
    6024             :         ;; Let's hope that BS2000 recognize this anyway:
    6025           0 :         name))))
    6026             : 
    6027             : (or (assq 'bs2000 ange-ftp-fix-name-func-alist)
    6028             :     (setq ange-ftp-fix-name-func-alist
    6029             :           (cons '(bs2000 . ange-ftp-fix-name-for-bs2000)
    6030             :                 ange-ftp-fix-name-func-alist)))
    6031             : 
    6032             : ;; Convert name from UNIX-ish to BS2000 ready for a DIRectory listing.
    6033             : ;; Remember that there are no directories in BS2000.
    6034             : (defun ange-ftp-fix-dir-name-for-bs2000 (dir-name)
    6035           0 :   (if (string-equal dir-name "/")
    6036             :       "*" ;; Don't use an empty string here!
    6037           0 :     (ange-ftp-fix-name-for-bs2000 dir-name)))
    6038             : 
    6039             : (or (assq 'bs2000 ange-ftp-fix-dir-name-func-alist)
    6040             :     (setq ange-ftp-fix-dir-name-func-alist
    6041             :           (cons '(bs2000 . ange-ftp-fix-dir-name-for-bs2000)
    6042             :                 ange-ftp-fix-dir-name-func-alist)))
    6043             : 
    6044             : (or (memq 'bs2000 ange-ftp-dumb-host-types)
    6045             :     (setq ange-ftp-dumb-host-types
    6046             :           (cons 'bs2000 ange-ftp-dumb-host-types)))
    6047             : 
    6048             : (defvar ange-ftp-bs2000-host-regexp nil)
    6049             : (defvar ange-ftp-bs2000-posix-host-regexp nil)
    6050             : 
    6051             : ;; Return non-nil if HOST is running BS2000.
    6052             : (defun ange-ftp-bs2000-host (host)
    6053           0 :   (and ange-ftp-bs2000-host-regexp
    6054           0 :        (string-match-p ange-ftp-bs2000-host-regexp host)))
    6055             : ;; Return non-nil if HOST is running BS2000 with POSIX subsystem.
    6056             : (defun ange-ftp-bs2000-posix-host (host)
    6057           0 :   (and ange-ftp-bs2000-posix-host-regexp
    6058           0 :        (string-match-p ange-ftp-bs2000-posix-host-regexp host)))
    6059             : 
    6060             : (defun ange-ftp-add-bs2000-host (host)
    6061             :   "Mark HOST as the name of a machine running BS2000."
    6062             :   (interactive
    6063           0 :    (list (read-string "Host: "
    6064           0 :                       (let ((name (or (buffer-file-name) default-directory)))
    6065           0 :                         (and name (car (ange-ftp-ftp-name name)))))))
    6066           0 :   (if (not (ange-ftp-bs2000-host host))
    6067           0 :       (setq ange-ftp-bs2000-host-regexp
    6068           0 :             (concat "^" (regexp-quote host) "$"
    6069           0 :                     (and ange-ftp-bs2000-host-regexp "\\|")
    6070           0 :                     ange-ftp-bs2000-host-regexp)
    6071           0 :             ange-ftp-host-cache nil)))
    6072             : 
    6073             : (defun ange-ftp-add-bs2000-posix-host (host)
    6074             :   "Mark HOST as the name of a machine running BS2000 with POSIX subsystem."
    6075             :   (interactive
    6076           0 :    (list (read-string "Host: "
    6077           0 :                       (let ((name (or (buffer-file-name) default-directory)))
    6078           0 :                         (and name (car (ange-ftp-ftp-name name)))))))
    6079           0 :   (if (not (ange-ftp-bs2000-posix-host host))
    6080           0 :       (setq ange-ftp-bs2000-posix-host-regexp
    6081           0 :             (concat "^" (regexp-quote host) "$"
    6082           0 :                     (and ange-ftp-bs2000-posix-host-regexp "\\|")
    6083           0 :                     ange-ftp-bs2000-posix-host-regexp)
    6084           0 :             ange-ftp-host-cache nil))
    6085             :   ;; Install CD hook to cd to posix on connecting:
    6086           0 :   (add-hook 'ange-ftp-process-startup-hook 'ange-ftp-bs2000-cd-to-posix)
    6087           0 :   host)
    6088             : 
    6089             : (defconst ange-ftp-bs2000-filename-regexp
    6090             :   (concat
    6091             :    "\\(" ange-ftp-bs2000-filename-prefix-regexp "\\)?"
    6092             :    "\\(" ange-ftp-bs2000-short-filename-regexp "\\)")
    6093             :   "Regular expression to match for a valid BS2000 file name.")
    6094             : 
    6095             : (defcustom ange-ftp-bs2000-additional-pubsets
    6096             :   nil
    6097             :   "List of additional pubsets available to all users."
    6098             :   :group 'ange-ftp
    6099             :   :type '(repeat string))
    6100             : 
    6101             : ;; These parsing functions are as general as possible because the syntax
    6102             : ;; of ftp listings from BS2000 hosts is a bit erratic. What saves us is that
    6103             : ;; the BS2000 filename syntax is so rigid.
    6104             : 
    6105             : ;; Extract the next filename from a BS2000 dired-like listing.
    6106             : (defun ange-ftp-parse-bs2000-filename ()
    6107           0 :   (if (re-search-forward ange-ftp-bs2000-filename-regexp nil t)
    6108           0 :       (match-string 2)))
    6109             : 
    6110             : ;; Parse the current buffer which is assumed to be in (some) BS2000 FTP dir
    6111             : ;; format, and return a hashtable as the result.
    6112             : (defun ange-ftp-parse-bs2000-listing ()
    6113           0 :   (let ((tbl (make-hash-table :test 'equal))
    6114             :         pubset
    6115             :         file)
    6116             :     ;; get current pubset
    6117           0 :     (goto-char (point-min))
    6118           0 :     (if (re-search-forward ange-ftp-bs2000-filename-pubset-regexp nil t)
    6119           0 :         (setq pubset (match-string 0)))
    6120             :     ;; add files to hashtable
    6121           0 :     (goto-char (point-min))
    6122           0 :     (save-match-data
    6123           0 :       (while (setq file (ange-ftp-parse-bs2000-filename))
    6124           0 :         (puthash file nil tbl)))
    6125             :     ;; add . and ..
    6126           0 :     (puthash "." t tbl)
    6127           0 :     (puthash ".." t tbl)
    6128             :     ;; add all additional pubsets, if not listing one of them
    6129           0 :     (if (not (member pubset ange-ftp-bs2000-additional-pubsets))
    6130           0 :         (mapc (lambda (pubset) (puthash pubset t tbl))
    6131           0 :               ange-ftp-bs2000-additional-pubsets))
    6132           0 :     tbl))
    6133             : 
    6134             : (add-to-list 'ange-ftp-parse-list-func-alist
    6135             :              '(bs2000 . ange-ftp-parse-bs2000-listing))
    6136             : 
    6137             : (defun ange-ftp-bs2000-cd-to-posix ()
    6138             :   "cd to POSIX subsystem if the current host matches
    6139             : `ange-ftp-bs2000-posix-host-regexp'.  All BS2000 hosts with POSIX subsystem
    6140             : MUST BE EXPLICITLY SET with `ange-ftp-add-bs2000-posix-host' for they cannot
    6141             : be recognized automatically (they are all valid BS2000 hosts too)."
    6142           0 :   (if (and ange-ftp-this-host (ange-ftp-bs2000-posix-host ange-ftp-this-host))
    6143           0 :       (progn
    6144             :         ;; change to POSIX:
    6145             : ;       (ange-ftp-raw-send-cmd proc "cd %POSIX")
    6146           0 :         (ange-ftp-cd ange-ftp-this-host ange-ftp-this-user "%POSIX")
    6147             :         ;; put new home directory in the expand-dir hashtable.
    6148             :         ;; `ange-ftp-this-host' and `ange-ftp-this-user' are bound in
    6149             :         ;; ange-ftp-get-process.
    6150           0 :         (puthash (concat ange-ftp-this-host "/" ange-ftp-this-user "/~")
    6151           0 :                  (car (ange-ftp-get-pwd ange-ftp-this-host ange-ftp-this-user))
    6152           0 :                  ange-ftp-expand-dir-hashtable))))
    6153             : 
    6154             : ;; Not available yet:
    6155             : ;; ange-ftp-bs2000-delete-file-entry
    6156             : ;; ange-ftp-bs2000-add-file-entry
    6157             : ;; ange-ftp-bs2000-file-name-as-directory
    6158             : ;; ange-ftp-bs2000-make-compressed-filename
    6159             : ;; ange-ftp-bs2000-file-name-sans-versions
    6160             : 
    6161             : ;;;; ------------------------------------------------------------
    6162             : ;;;; Finally provide package.
    6163             : ;;;; ------------------------------------------------------------
    6164             : 
    6165             : (provide 'ange-ftp)
    6166             : 
    6167             : ;;; ange-ftp.el ends here

Generated by: LCOV version 1.12