Don't gratuitously parse ~/.netrc.

This commit is contained in:
sperber 2003-01-16 12:39:36 +00:00
parent bb84449320
commit bd368af1dc
1 changed files with 25 additions and 16 deletions

View File

@ -122,23 +122,32 @@
;; try to determine a login and password for the server. ;; try to determine a login and password for the server.
(define (ftp-login connection login password) (define (ftp-login connection login password)
(let* ((netrc-record (netrc-parse)) (let* ((netrc-record #f)
(login (or login (get-netrc-record
(netrc-lookup-login netrc-record (lambda ()
(ftp-connection-host-name connection)))) (cond
(password (or password (netrc-record)
(netrc-lookup-password netrc-record (else
(ftp-connection-host-name connection))))) (set! netrc-record (netrc-parse))
(let ((reply netrc-record)))))
(ftp-send-command connection (ftp-build-command-string "USER" login) (let ((login (or login
(lambda (code) (netrc-lookup-login (get-netrc-record)
(or (string=? code "331") ; "User name okay, need password." (ftp-connection-host-name connection)))))
(string=? code "230")))))) ; "User logged in, proceed." (let ((reply
(ftp-send-command connection (ftp-build-command-string "USER" login)
(lambda (code)
(or (string=? code "331") ; "User name okay, need password."
(string=? code "230")))))) ; "User logged in, proceed."
(if (string-prefix? "331" reply) ; "User name okay, need password." (if (string-prefix? "331" reply) ; "User name okay, need password."
(ftp-send-command connection (ftp-send-command connection
(ftp-build-command-string "PASS" password) (ftp-build-command-string
(exactly-code "230")))))) "PASS"
(or password
(netrc-lookup-password (get-netrc-record)
(ftp-connection-host-name
connection))))
(exactly-code "230")))))))
;; Type must be one of 'binary or 'text or 'ascii, or a string which will be ;; Type must be one of 'binary or 'text or 'ascii, or a string which will be
;; sent verbatim ;; sent verbatim