;;; ange-ftp.el --- transparent FTP support for GNU Emacs
-;; Copyright (C) 1989,90,91,92,93,94,95 Free Software Foundation, Inc.
+;; Copyright (C) 1989,90,91,92,93,94,95,96 Free Software Foundation, Inc.
;; Author: Andy Norman (ange@hplb.hpl.hp.com)
+;; Maintainer: FSF
;; Keywords: comm
;; This file is part of GNU Emacs.
"*If non-nil avoid checking permissions on the .netrc file.")
(defvar ange-ftp-default-user nil
- "*User name to use when none is specied in a file name.
-If nil, then the name under which the user is logged in is used.
-If non-nil but not a string, the user is prompted for the name.")
+ "*User name to use when none is specified in a file name.
+If non-nil but not a string, you are prompted for the name.
+If nil, the value of `ange-ftp-netrc-default-user' is used.
+If that is nil too, then your login name is used.
+
+Once a connection to a given host has been initiated, the user name
+and password information for that host are cached and re-used by
+ange-ftp. Use `ange-ftp-set-user' to change the cached values,
+since setting `ange-ftp-default-user' directly does not affect
+the cached information.")
+
+(defvar ange-ftp-netrc-default-user nil
+ "Alternate default user name to use when none is specified.
+This variable is set from the `default' command in your `.netrc' file,
+if there is one.")
(defvar ange-ftp-default-password nil
- "*Password to use when the user is the same as ange-ftp-default-user.")
+ "*Password to use when the user name equals `ange-ftp-default-user'.")
(defvar ange-ftp-default-account nil
- "*Account password to use when the user is the same as ange-ftp-default-user.")
+ "*Account to use when the user name equals `ange-ftp-default-user'.")
+
+(defvar ange-ftp-netrc-default-password nil
+ "*Password to use when the user name equals `ange-ftp-netrc-default-user'.")
+
+(defvar ange-ftp-netrc-default-account nil
+ "*Account to use when the user name equals `ange-ftp-netrc-default-user'.")
(defvar ange-ftp-generate-anonymous-password t
"*If t, use value of `user-mail-address' as password for anonymous ftp.
(let ((enable-recursive-minibuffers t))
(read-string (format "User for %s: " host)
(user-login-name))))
+ (ange-ftp-netrc-default-user)
;; Default to the user's login name.
(t
(user-login-name))))
"Read a password, echoing `.' for each character typed.
End with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line.
Optional DEFAULT is password to start with."
- (let ((pass (if default default ""))
+ (let ((pass nil)
(c 0)
(echo-keystrokes 0)
(cursor-in-echo-area t))
(setq pass (substring pass 0 -1))))))
(message "")
(ange-ftp-repaint-minibuffer)
- pass))
+ (or pass default "")))
(defmacro ange-ftp-generate-passwd-key (host user)
(` (concat (, host) "/" (, user))))
;; defaults.
(cond ((ange-ftp-lookup-passwd host user))
- ;; see if default user and password set from the .netrc file.
+ ;; See if default user and password set.
((and (stringp ange-ftp-default-user)
ange-ftp-default-password
(string-equal user ange-ftp-default-user))
ange-ftp-default-password)
+ ;; See if default user and password set from .netrc file.
+ ((and (stringp ange-ftp-netrc-default-user)
+ ange-ftp-netrc-default-password
+ (string-equal user ange-ftp-netrc-default-user))
+ ange-ftp-netrc-default-password)
+
;; anonymous ftp password is handled specially since there is an
;; unwritten rule about how that is used on the Internet.
((and (or (string-equal user "anonymous")
;; found another machine with the same user.
;; Try that account.
(ange-ftp-read-passwd
- (format "passwd for %s@%s (same as %s@%s): "
+ (format "passwd for %s@%s (default same as %s@%s): "
user host user other)
(ange-ftp-lookup-passwd other user))
ange-ftp-account-hashtable)
(and (stringp ange-ftp-default-user)
(string-equal user ange-ftp-default-user)
- ange-ftp-default-account)))
+ ange-ftp-default-account)
+ (and (stringp ange-ftp-netrc-default-user)
+ (string-equal user ange-ftp-netrc-default-user)
+ ange-ftp-netrc-default-account)))
\f
;;;; ------------------------------------------------------------
;;;; ~/.netrc support
password (ange-ftp-parse-netrc-token "password" end)
account (ange-ftp-parse-netrc-token "account" end))
(and login
- (setq ange-ftp-default-user login))
+ (setq ange-ftp-netrc-default-user login))
(and password
- (setq ange-ftp-default-password password))
+ (setq ange-ftp-netrc-default-password password))
(and account
- (setq ange-ftp-default-account account)))))
+ (setq ange-ftp-netrc-default-account account)))))
(goto-char end)))
;; Read in ~/.netrc, if one exists. If ~/.netrc file exists and has
(ange-ftp-ftp-name buffer-file-name))
(auto-save-mode ange-ftp-auto-save)))
-(defun ange-ftp-kill-ftp-process (buffer)
- "Kill the FTP process associated with BUFFER.
+(defun ange-ftp-kill-ftp-process (&optional buffer)
+ "Kill the FTP process associated with BUFFER (the current buffer, if nil).
If the BUFFER's visited filename or default-directory is an ftp filename
then kill the related ftp process."
(interactive "bKill FTP process associated with buffer: ")
(if (null buffer)
- (setq buffer (current-buffer)))
- (let ((file (or (buffer-file-name) default-directory)))
+ (setq buffer (current-buffer))
+ (setq buffer (get-buffer buffer)))
+ (let ((file (or (buffer-file-name buffer)
+ (save-excursion (set-buffer buffer) default-directory))))
(if file
(let ((parsed (ange-ftp-ftp-name (expand-file-name file))))
(if parsed
(let ((buffer (process-buffer proc))
(old-buffer (current-buffer)))
+ ;; Eliminate nulls.
+ (while (string-match "\000+" str)
+ (setq str (replace-match "" nil nil str)))
+
;; see if the buffer is still around... it could have been deleted.
(if (buffer-name buffer)
(unwind-protect
(if (memq (process-status proc) '(run open))
(save-excursion
(set-buffer (process-buffer proc))
- (while ange-ftp-process-busy
- ;; This is a kludge to let user quit in case ftp gets hung.
- ;; It matters because this function can be called from the filter.
- ;; It is bad to allow quitting in a filter, but getting hung
- ;; is worse. By binding quit-flag to nil, we might avoid
- ;; most of the probability of getting screwed because the user
- ;; wants to quit some command.
- (let ((quit-flag nil)
- (inhibit-quit nil))
- (accept-process-output)))
+ (ange-ftp-wait-not-busy proc)
(setq ange-ftp-process-string ""
ange-ftp-process-result-line ""
ange-ftp-process-busy t
(set-marker (process-mark proc) (point))
(if nowait
nil
- ;; hang around for command to complete
- (while ange-ftp-process-busy
- ;; This is a kludge to let user quit in case ftp gets hung.
- ;; It matters because this function can be called from the filter.
- (let ((quit-flag nil)
- (inhibit-quit nil))
- (accept-process-output proc)))
+ (ange-ftp-wait-not-busy proc)
(if cont
nil ;cont has already been called
(cons ange-ftp-process-result ange-ftp-process-result-line))))))
+;; Wait for the ange-ftp process PROC not to be busy.
+(defun ange-ftp-wait-not-busy (proc)
+ (save-excursion
+ (set-buffer (process-buffer proc))
+ (condition-case nil
+ ;; This is a kludge to let user quit in case ftp gets hung.
+ ;; It matters because this function can be called from the filter.
+ ;; It is bad to allow quitting in a filter, but getting hung
+ ;; is worse. By binding quit-flag to nil, we might avoid
+ ;; most of the probability of getting screwed because the user
+ ;; wants to quit some command.
+ (let ((quit-flag nil)
+ (inhibit-quit nil))
+ (while ange-ftp-process-busy
+ (accept-process-output proc)))
+ (quit
+ ;; If the user does quit out of this,
+ ;; kill the process. That stops any transfer in progress.
+ ;; The next operation will open a new ftp connection.
+ (delete-process proc)
+ (signal 'quit nil)))))
+
(defun ange-ftp-nslookup-host (host)
"Attempt to resolve the given HOSTNAME using nslookup if possible."
(interactive "sHost: ")
(abbr (ange-ftp-abbreviate-filename filename)))
(unwind-protect
(progn
- (let ((executing-macro t)
+ (let ((executing-kbd-macro t)
(filename (buffer-file-name))
(mod-p (buffer-modified-p)))
(unwind-protect
;; Turn off RCS/SCCS processing to save time.
;; This returns nil for any file name as argument.
(put 'vc-registered 'ange-ftp 'null)
+
+(put 'dired-call-process 'ange-ftp 'ange-ftp-dired-call-process)
\f
;;; Define ways of getting at unmodified Emacs primitives,
;;; turning off our handler.
;; default-directory is in ange-ftp syntax for remote file names.
(ange-ftp-real-shell-command command))))
-;;; Thisis not hooked up yet.
+;;; This is the handler for call-process.
(defun ange-ftp-dired-call-process (program discard &rest arguments)
;; PROGRAM is always one of those below in the cond in dired.el.
;; The ARGUMENTS are (nearly) always files.
(ftp-error (insert (format "%s: %s, %s\n"
(nth 1 oops)
(nth 2 oops)
- (nth 3 oops))))
- (error (insert (format "%s\n" (nth 1 oops)))))
+ (nth 3 oops)))
+ ;; Caller expects nonzero value to mean failure.
+ 1)
+ (error (insert (format "%s\n" (nth 1 oops)))
+ 1))
(apply 'call-process program nil (not discard) nil arguments)))
-;;; This currently does not work; it is never called.
+(defvar ange-ftp-remote-shell "rsh"
+ "Remote shell to use for chmod, if FTP server rejects the `chmod' command.")
+
+;; Handle an attempt to run chmod on a remote file
+;; by using the ftp chmod command.
(defun ange-ftp-call-chmod (args)
(if (< (length args) 2)
(error "ange-ftp-call-chmod: missing mode and/or filename: %s" args))
(format "doing chmod %s"
abbr))))
(or (car result)
- (ange-ftp-error host user
- (format "chmod: %s: \"%s\""
- file
- (cdr result)))))))))
+ (call-process
+ ange-ftp-remote-shell
+ nil t nil host "chmod" mode name)))))))
(cdr args)))
- (setq ange-ftp-ls-cache-file nil)) ;stop confusing dired
+ (setq ange-ftp-ls-cache-file nil) ;Stop confusing Dired.
+ 0)
\f
;;; This is turned off because it has nothing properly to do
;;; with dired. It could be reasonable to adapt this to
file
;; give up
(ange-ftp-error ange-ftp-this-host ange-ftp-this-user
- (format "cd to minidisk %s failed: "
+ (format "cd to minidisk %s failed: %s"
minidisk (cdr result))))))))
(t (error "Invalid CMS file name"))))
HCoop / bpt / emacs.git / blobdiff