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

Try to stick to specification of NETRC:PARSE: always return a netrc-record.

This commit is contained in:
interp 2002-04-04 23:22:28 +00:00
parent e961d4f595
commit 9d496f8d6f
1 changed files with 31 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
netrc.scm
View File

@ -1,6 +1,6 @@
;;; netrc.scm -- parse authentication information contained in ~/.netrc
;;
;; $Id: netrc.scm,v 1.6 2002/04/04 22:39:15 interp Exp $
;; $Id: netrc.scm,v 1.7 2002/04/04 23:22:28 interp Exp $
;;
;; Please send suggestions and bug reports to <emarsden@mail.dotcom.fr>
@ -228,33 +228,44 @@
(with-handler
(lambda (error more)
(if (netrc-refuse? error)
(begin
(format (current-error-port)
"netrc: Warning: ~a~%"
(car (condition-stuff error)))
(exit (local-default-netrc-record)))))
(format (current-error-port)
"netrc: Warning: ~a~%"
(car (condition-stuff error)))
(format (current-error-port)
"netrc: Warning: Unexpected error encountered: ~s~%"
error))
(exit (local-default-netrc-record)))
(lambda ()
(with-errno-handler*
(lambda (errno packet)
(if (= errno errno/noent)
(begin
(format (current-error-port)
"netrc: Warning: no such file or directory: ~a~%"
file-name)
(exit (local-default-netrc-record)))))
(format (current-error-port)
"netrc: Warning: no such file or directory: ~a~%"
file-name)
(format (current-error-port)
"netrc: Warning: Error accessing file ~s~%"
file-name))
(exit (local-default-netrc-record)))
(lambda ()
(let ((netrc-record
(netrc:try-parse file-name default-password default-login)))
(if netrc-record
netrc-record
; If we get a netrc-record, we return it after
; checking default login and default password settings.
; Otherwise, we return the default record with
; file-name stored.
; This is sub-optimal, as we may throw away badly
; structured .netrc-files silently. We need an error
; checking mechanism.
(if (netrc? netrc-record)
(begin
(set-netrc:default-password
netrc-record
(or default-password (local-default-password)))
(set-netrc:default-login
netrc-record
(or default-login (local-default-login)))
netrc-record))))))))))))
(if (eq? (netrc:default-login netrc-record) #f)
(set-netrc:default-login (local-default-login)))
(if (eq? (netrc:default-password netrc-record) #f)
(set-netrc:default-password (local-default-password)))
netrc-record)
(let ((default-netrc-record (local-default-netrc-record)))
(set-netrc:file-name default-netrc-record file-name)
default-netrc-record))))))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; nothing exported below