scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
scheme/lib/ftp.scm
View File

@ -122,23 +122,32 @@
;; try to determine a login and password for the server.
(define (ftp-login connection login password)
(let* ((netrc-record (netrc-parse))
(login (or login
(netrc-lookup-login netrc-record
(ftp-connection-host-name connection))))
(password (or password
(netrc-lookup-password netrc-record
(ftp-connection-host-name connection)))))
(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."
(let* ((netrc-record #f)
(get-netrc-record
(lambda ()
(cond
(netrc-record)
(else
(set! netrc-record (netrc-parse))
netrc-record)))))
(let ((login (or login
(netrc-lookup-login (get-netrc-record)
(ftp-connection-host-name connection)))))
(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."
(ftp-send-command connection
(ftp-build-command-string "PASS" password)
(exactly-code "230"))))))
(if (string-prefix? "331" reply) ; "User name okay, need password."
(ftp-send-command connection
(ftp-build-command-string
"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
;; sent verbatim