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

Better fix for git checkout problem

Browse Source
This commit is contained in:
Jay McCarthy 2017-10-28 07:23:28 -04:00
parent 12febe5cc2
commit 033cd43b8f
2 changed files with 18 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -8,7 +8,7 @@
(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?
(with-handlers ([exn:fail:git?
(λ (x)
(if (empty? (rest credentials-list))
(raise x)

26
racket/collects/pkg/private/stage.rkt
View File

@ -745,15 +745,23 @@
(git-checkout host #:port port repo
#:dest-dir #f
#:ref branch
#:status-printf (lambda (fmt . args)
(define (strip-ending-newline s)
(regexp-replace #rx"\n$" s ""))
(log-pkg-debug (strip-ending-newline (apply format fmt args))))
#:initial-error (lambda ()
(pkg-error (~a "Git checkout initial protocol failed;\n"
" the given URL might not refer to a Git repository\n"
" given URL: ~a")
pkg-url-str))
#:status-printf
(lambda (fmt . args)
(define (strip-ending-newline s)
(regexp-replace #rx"\n$" s ""))
(log-pkg-debug
(strip-ending-newline (apply format fmt args))))
#:initial-error
(lambda ()
(raise
;; This is a git error so that
;; call-with-git-checkout-credentials will retry
(exn:fail:git
(~a "pkg: Git checkout initial protocol failed;\n"
" the given URL might not refer to a Git repository\n"
" given URL: "
pkg-url-str)
(current-continuation-marks))))
#:transport transport)))))]
[(github)
(match-define (list* user repo branch path)