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 ;;; 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> ;; Please send suggestions and bug reports to <emarsden@mail.dotcom.fr>
@ -228,33 +228,44 @@
(with-handler (with-handler
(lambda (error more) (lambda (error more)
(if (netrc-refuse? error) (if (netrc-refuse? error)
(begin (format (current-error-port)
(format (current-error-port) "netrc: Warning: ~a~%"
"netrc: Warning: ~a~%" (car (condition-stuff error)))
(car (condition-stuff error))) (format (current-error-port)
(exit (local-default-netrc-record))))) "netrc: Warning: Unexpected error encountered: ~s~%"
error))
(exit (local-default-netrc-record)))
(lambda () (lambda ()
(with-errno-handler* (with-errno-handler*
(lambda (errno packet) (lambda (errno packet)
(if (= errno errno/noent) (if (= errno errno/noent)
(begin (format (current-error-port)
(format (current-error-port) "netrc: Warning: no such file or directory: ~a~%"
"netrc: Warning: no such file or directory: ~a~%" file-name)
file-name) (format (current-error-port)
(exit (local-default-netrc-record))))) "netrc: Warning: Error accessing file ~s~%"
file-name))
(exit (local-default-netrc-record)))
(lambda () (lambda ()
(let ((netrc-record (let ((netrc-record
(netrc:try-parse file-name default-password default-login))) (netrc:try-parse file-name default-password default-login)))
(if netrc-record ; If we get a netrc-record, we return it after
netrc-record ; 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 (begin
(set-netrc:default-password (if (eq? (netrc:default-login netrc-record) #f)
netrc-record (set-netrc:default-login (local-default-login)))
(or default-password (local-default-password))) (if (eq? (netrc:default-password netrc-record) #f)
(set-netrc:default-login (set-netrc:default-password (local-default-password)))
netrc-record netrc-record)
(or default-login (local-default-login))) (let ((default-netrc-record (local-default-netrc-record)))
netrc-record)))))))))))) (set-netrc:file-name default-netrc-record file-name)
default-netrc-record))))))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; nothing exported below ;; nothing exported below