Don't gratuitously parse ~/.netrc.
This commit is contained in:
parent
bb84449320
commit
bd368af1dc
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue