68 lines
2.8 KiB
Racket
68 lines
2.8 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/string
|
|
"git-provider.rkt")
|
|
|
|
(provide exn:fail:git-auth?
|
|
exn:fail:git-auth-command
|
|
exn:fail:git-auth-args
|
|
exn:fail:git-auth-exit-code
|
|
exn:fail:git-auth-output
|
|
authentication-failure?
|
|
raise-git-auth-error
|
|
current-git-authentication-handler)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Authentication exception
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(struct exn:fail:git-auth exn:fail
|
|
(command args exit-code output)
|
|
#:transparent)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Recognize output that indicates Git authentication failed.
|
|
; pre : exit-code and output belong to a completed Git command.
|
|
; post : output has only been inspected.
|
|
; result : #t when a known authentication failure is present, otherwise #f.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (authentication-failure? exit-code output)
|
|
(and (not (= exit-code 0))
|
|
(ormap
|
|
(λ (entry)
|
|
(let ((line (string-downcase (format "~a" (cadr entry)))))
|
|
(or (string-contains? line "authentication failed")
|
|
(string-contains? line "failed to authenticate")
|
|
(string-contains? line "could not read username")
|
|
(string-contains? line "could not read password")
|
|
(string-contains? line "http basic: access denied")
|
|
(string-contains? line "terminal prompts disabled"))))
|
|
output)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Raise a Git authentication exception containing the failed invocation.
|
|
; pre : cmd, args, exit-code and output describe a failed Git command.
|
|
; post : An exn:fail:git-auth exception has been raised.
|
|
; result : No normal return value.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (raise-git-auth-error cmd args exit-code output)
|
|
(let ((msg (format "git ~a: authentication failed" cmd)))
|
|
(raise
|
|
(exn:fail:git-auth msg
|
|
(current-continuation-marks)
|
|
cmd
|
|
args
|
|
exit-code
|
|
output))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Supply the callback that can resolve an authentication failure.
|
|
; pre : The callback accepts command, arguments and an exn:fail:git-auth value.
|
|
; post : The callback is used by command proxies before one authentication retry.
|
|
; result : A parameter containing the current authentication callback.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define current-git-authentication-handler
|
|
(make-parameter
|
|
(λ (cmd args e)
|
|
#f)))
|