heiser@iis.UUCP (Gernot Heiser) (11/10/89)
In article <8911061623.AA01008@wssi3.wp> wpmstr!wssi3!fbresz@sunpitt.east.sun.com writes: > >In GNU Emacs 18.52.3 of Tue Apr 11 1989 on omaha1 (berkeley-unix) > > I just discovered the use of ftp-find-file, ftp-write-file. I have >found a bug in the latter. When I use ftp-find-file to get a file over the >net it correctly sets itself up so the save-buffer calls ftp-write-file. >Now here is the bug. > > The file gets correctly written across the net. I know it does >because I remotely logged in on the other machine and cat'ed it. However >the buffer does not get marked as unmodified. For reference I am running >on a SUN-3 running SUN OS 4.0.3 and the remote machine is a SUN-386i >running SUN OS 4.0.1. I looked into the code in ftp.el and found what >appears to be a check to set the state correctly but it fails for an >unknown reason. > I run into that quite a while ago and fixed it. The following diff also contains code posted about 2 years ago by someone else (don't remember the name) which suppresses echoing when entering the password. Furthermore I added support for a ~/.netrc file (containing login names and passwords for remote machines). This is compatible with UNICOS ftp and makes life much easier when working with a Cray that is supposed to keep all those nasty Ruskies off... (Yea, security REALLY sucks!) The following diff is relative to version 18.55, but I don't think the file has changed since 18.51 (at least). *** ftp.el.orig Tue Jul 19 08:21:43 1988 --- ftp.el Wed Nov 8 19:03:13 1989 *************** *** 20,36 **** ;; and this notice must be preserved on all copies. ;; you can turn this off by doing ;; (setq ftp-password-alist 'compulsory-urinalysis) (defvar ftp-password-alist () "Security sucks") (defun read-ftp-user-password (host user new) (let (tem) ! (if (and (not new) ! (listp ftp-password-alist) ! (setq tem (cdr (assoc host ftp-password-alist))) ! (or (null user) ! (string= user (car tem)))) tem (or user (progn --- 20,79 ---- ;; and this notice must be preserved on all copies. + ;; 1988-11-20 heiser@iis.ethz.ch: + ;; fixed so it can handle UNICOS ftp which doesn't allow a password + ;; on a "user" command line. Also made buffer-modified false after writing + + ;; 1989-04-20 heiser@iis.ethz.ch: + ;; support for ~/.netrc file. This file may contain logins and passwords + ;; for use by (some versions of) ftp. It consists of lines of the form + ;; machine <host> login <user> password <password> + ;; Passwords containing spaces may be put in double quotes. + + ;; you can turn this off by doing ;; (setq ftp-password-alist 'compulsory-urinalysis) (defvar ftp-password-alist () "Security sucks") + (defun ftp-get-passwd-from-netrc (host) ; gh (whole function) + "try to obtain login name and password for host from ~/.netrc file + (if any). Return (nil nil) if not successful" + (find-file-read-only "~/.netrc") + (let ((user nil) (passwd nil) line-end old-point) + (and (re-search-forward (concat "^\\s *machine\\s +" + host + "\\s +login\\s +") + nil t) + (setq line-end (save-excursion (end-of-line) (point))) + (setq user (if (and (setq old-point (point)) + (re-search-forward "[a-z0-9]+" line-end t) + (= old-point (match-beginning 0))) + (buffer-substring old-point (match-end 0)) + nil)) + (re-search-forward "\\s +password\\s +" line-end t) + (setq passwd (if (and (setq old-point (point)) + (re-search-forward "\\S +\\|\"[^\"]*\"\\|'[^']*'" + line-end t) + (= old-point (match-beginning 0))) + (buffer-substring old-point (match-end 0)) + nil)) + (setq passwd (if (or (= ?' (string-to-char passwd)) + (= ?\" (string-to-char passwd))) + (substring passwd 1 -1) + passwd))) + (kill-buffer (current-buffer)) + (cons user passwd))) + (defun read-ftp-user-password (host user new) (let (tem) ! (if (or (and (not new) ; gh ! (listp ftp-password-alist) ! (setq tem (cdr (assoc host ftp-password-alist))) ! (or (null user) ! (string= user (car tem)))) ! (and (setq tem (ftp-get-passwd-from-netrc host)) ; gh ! (setq user (car tem)) ; gh ! (not (null (cdr tem))))) ; gh tem (or user (progn *************** *** 42,50 **** host tem))) (if (equal user "") (setq user tem)))) (setq tem (cons user ! ;; If you want to use some non-echoing string-reader, ! ;; feel free to write it yourself. I don't care enough. ! (read-string (format "Password for %s@%s: " user host) (if (not (listp ftp-password-alist)) "" (or (cdr (cdr (assoc host ftp-password-alist))) --- 85,92 ---- host tem))) (if (equal user "") (setq user tem)))) (setq tem (cons user ! (read-string-no-echo ! (format "Password for %s@%s: " user host) (if (not (listp ftp-password-alist)) "" (or (cdr (cdr (assoc host ftp-password-alist))) *************** *** 63,68 **** --- 105,121 ---- ftp-password-alist))) tem))) + (defun read-string-no-echo (prompt &optional initial-input) + (let (input-char + (answer (if initial-input initial-input)) + (cursor-in-echo-area t)) + (message prompt) + (while (and (not (= (setq input-char (read-char)) ?\C-m)) + (not (= input-char ?\C-j))) + (setq answer (concat answer (list input-char))) + (message prompt)) + answer)) + (defun ftp-read-file-name (prompt) (let ((s "")) (while (not (string-match "\\`[ \t]*\\([^ \t:]+\\)[ \t]*:\\(.+\\)\\'" s)) *************** *** 100,106 **** (defun ftp-find-file-or-directory (host file filep &optional user password) "FTP to HOST to get FILE. Third arg is t for file, nil for directory. Log in as USER with PASSWORD. If USER is nil or PASSWORD is nil or t, ! we prompt for the user name and password." (or (and user password (not (eq password t))) (progn (setq user (read-ftp-user-password host user (eq password t)) password (cdr user) --- 153,160 ---- (defun ftp-find-file-or-directory (host file filep &optional user password) "FTP to HOST to get FILE. Third arg is t for file, nil for directory. Log in as USER with PASSWORD. If USER is nil or PASSWORD is nil or t, ! and we cannot use a ~/.netrc file ! we prompt for the user name and password." ; gh (or (and user password (not (eq password t))) (progn (setq user (read-ftp-user-password host user (eq password t)) password (cdr user) *************** *** 210,219 **** (defun ftp-login (process host user password) (message "FTP logging in as %s@%s..." user host) ! (if (ftp-command process ! (format "open %s\nuser %s %s\n" host user password) ! "230.*\n" ! "\\(Connected to \\|220\\|331\\).*\n") t (switch-to-buffer (process-buffer process)) (delete-process process) --- 264,277 ---- (defun ftp-login (process host user password) (message "FTP logging in as %s@%s..." user host) ! (if (and (ftp-command process ; gh ! (format "open %s\nuser %s\n" host user) ; gh ! "[Pp]assword.*" ; gh ! "\\(Connected to \\|220\\|331\\).*\n") ; gh ! (ftp-command process ; gh ! (format "%s\n" password) ; gh ! "230.*\n" ; gh ! "\\(Connected to \\|220\\|331\\).*\n")) ; gh t (switch-to-buffer (process-buffer process)) (delete-process process) *************** *** 230,236 **** ((looking-at win) (goto-char (point-max)) (setq p t)) ! ((looking-at "^ftp> \\|^\n") (goto-char (match-end 0))) ((looking-at ignore) (forward-line 1)) --- 288,294 ---- ((looking-at win) (goto-char (point-max)) (setq p t)) ! ((looking-at "^ftp> \\|\n") ; gh (goto-char (match-end 0))) ((looking-at ignore) (forward-line 1)) *************** *** 263,268 **** --- 321,329 ---- ((and (eq (process-status process) 'exit) (= (process-exit-status process) 0)) (save-excursion + (if (not input) ; gh + (set-buffer-modified-p nil) ; gh + (setq buffer-read-only nil)) ; gh (set-buffer (process-buffer process)) (let (msg (r (if input "[0-9]+ bytes received in [0-9]+\\.[0-9]+ seconds.*$" "[0-9]+ bytes sent in [0-9]+\\.[0-9]+ seconds.*$")) -- Gernot Heiser Phone: +41 1/256 23 48 Integrated Systems Laboratory CSNET/ARPA: heiser%iis.ethz.ch@relay.cs.net ETH Zuerich UUCP (new): heiser@iis.uucp CH-8092 Zuerich, Switzerland UUCP (old): {uunet,mcvax,...}!iis!heiser