suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Catch all errors so credentials are tried

Browse Source
This commit is contained in:
Jay McCarthy 2017-10-27 16:20:02 -04:00
parent 259e3a6fe1
commit 9b1c71a381
1 changed files with 11 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
racket/collects/pkg/private/checkout-credentials.rkt
View File

@ -1,24 +1,26 @@
#lang racket/base
(require net/git-checkout
racket/list
"config.rkt")
(provide call-with-git-checkout-credentials)
(define (call-with-git-checkout-credentials thunk)
(define (call-with-git-checkout-credentials t)
(let loop ([credentials-list (cons #f (get-git-checkout-credentials))])
(define credentials (first credentials-list))
(with-handlers ([exn:fail:git? (λ (exn)
(if (empty? (rest credentials-list))
(raise exn)
(loop (rest credentials-list))))])
(with-handlers ([exn:fail?
(λ (x)
(if (empty? (rest credentials-list))
(raise x)
(loop (rest credentials-list))))])
(define c (make-custodian))
(parameterize ([current-custodian c]
[current-git-username (and credentials (hash-ref credentials 'username))]
[current-git-password (and credentials (hash-ref credentials 'password))])
[current-git-username
(and credentials (hash-ref credentials 'username))]
[current-git-password
(and credentials (hash-ref credentials 'password))])
(dynamic-wind
void
thunk
t
(lambda ()
(custodian-shutdown-all c)))))))