hans/git-cli
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Authentication

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-13 21:53:46 +02:00
parent 9f2e4b2bcc
commit c0bfc3485b
6 changed files with 109 additions and 51 deletions
Download Patch File Download Diff File Expand all files Collapse all files
README.md
+18 -15
View File
@@ -85,22 +85,25 @@ The result remains two values: Git's exit code and the ordered
## Authentication retry
Authentication failures are detected centrally after `run-git`, before
command-specific result processing. `current-git-authentication-handler`
defaults to `default-git-authentication-handler`.
Authentication failures are recognized centrally after `run-git`. The
recognizer covers common authentication/authorization errors, including HTTP
401 and 403 responses.
The default handler first uses an existing Git `credential.helper`. When no
helper is configured, it asks for username and password/token with
`input-prompt`, configures the non-persistent `cache` helper locally, approves
the credential through `git credential approve`, and retries the original Git
command once.
`current-git-authentication-handler` defaults to
`default-git-authentication-handler`. After an authentication failure the
default handler rejects the failed credential first. If a Git credential
helper exists, `git credential fill` is then tried so that helpers such as Git
Credential Manager can obtain a replacement credential.
A custom handler can still be installed:
When no usable credential is returned, git-cli asks for a username and
password/token using `input-prompt`. The `#:loop-until` callbacks validate the
input and return the final value, as intended by `input-prompt`. If no
credential helper is configured, git-cli configures the non-persistent `cache`
helper locally before approving the supplied credential.
```racket
(current-git-authentication-handler
(λ (cmd args e)
;; Perform custom credential handling.
#t))
```
The original Git command is retried once. If authentication fails again, the
credential used for that retry is rejected before the normal Git error is
raised. This prevents a bad token from remaining in the credential cache.
A custom handler can still be installed through
`current-git-authentication-handler`.
info.rkt
+1 -1
View File
@@ -2,7 +2,7 @@
(define collection "git-cli")
(define pkg-desc "Command-line-like Git operations for Racket, interface to the git cli command")
(define version "0.3.22")
(define version "0.3.23")
(define pkg-authors '("Hans Dijkema"))
(define license 'MIT)
private/git-auth.rkt
+50 -20
View File
@@ -13,6 +13,7 @@
authentication-failure?
raise-git-auth-error
default-git-authentication-handler
reject-git-authentication
current-git-authentication-handler)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -135,6 +136,18 @@
#:input (credential-input protocol host username password))))
(= exit-code 0)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Reject credentials for an HTTP(S) remote through Git.
; pre : protocol and host identify the credential; username may be #f.
; post : Git credential reject has been invoked.
; result : #t when Git accepted the reject operation, otherwise #f.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (git-credential-reject protocol host username)
(let-values (((exit-code output)
(run-git '(credential reject)
#:input (credential-input protocol host username #f))))
(= exit-code 0)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Ensure a non-persistent credential helper exists for this repository.
; pre : The current directory is inside a Git working tree.
@@ -155,6 +168,7 @@
; post : Supplied credentials have been offered to Git's helper.
; result : #t when credentials were approved, otherwise #f.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (ask-and-approve-credential protocol host username)
(let* ((username*
(if username
@@ -163,22 +177,29 @@
(format "Username for ~a: " host)
#:loop-until
(λ (value)
(if (and (string? value)
(not (string=? (string-trim value) "")))
(string-trim value)
#f)))))
(cond
((eof-object? value)
(error 'git-authentication "Input cancelled"))
((string=? (string-trim value) "")
#f)
(else
(string-trim value)))))))
(password
(input-prompt
(format "Password/token for ~a: " host)
#:loop-until
(λ (value)
(if (and (string? value)
(not (string=? value "")))
value
#f)))))
(cond
((eof-object? value)
(error 'git-authentication "Input cancelled"))
((string=? value "")
#f)
(else
value))))))
(and (ensure-credential-helper)
(git-credential-approve protocol host username* password))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Authentication handling
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -190,24 +211,15 @@
; result : #t when a known authentication failure is present, otherwise #f.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define auth-recognizers
'("authentication failed"
"failed to authenticate"
"could not read username"
"could not read password"
"http basic: access denied"
"access denied"
"terminal prompts disabled"
"requested url returned error: 401"
"requested url returned error: 403"
))
(define auth-recognizer
#px"(authentication failed|failed to authenticate|could not read (username|password)|access denied|terminal prompts disabled|requested url returned error: (401|403))")
(define (authentication-failure? exit-code output)
(and (not (= exit-code 0))
(ormap
(λ (entry)
(let ((line (string-downcase (format "~a" (cadr entry)))))
(ormap (λ (x) (string-contains? line x)) auth-recognizers)))
(regexp-match? auth-recognizer line)))
output)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -226,6 +238,22 @@
exit-code
output))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Reject the credential associated with a failed Git command.
; pre : cmd and args identify a failed authenticated Git invocation.
; post : Git's credential helper has been asked to forget the credential.
; result : #t when a credential could be identified and rejected, otherwise #f.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (reject-git-authentication cmd args)
(let ((url (git-authentication-url cmd args)))
(if (not url)
#f
(let-values (((protocol host username)
(url->credential-parts url)))
(if protocol
(git-credential-reject protocol host username)
#f)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Resolve an authentication failure using Git first, then input-prompt.
; pre : cmd, args and e describe one failed Git invocation.
@@ -241,6 +269,8 @@
(if (not protocol)
#f
(let ((helper (git-config-value "credential.helper")))
(when helper
(git-credential-reject protocol host username))
(if (and helper
(git-credential-fill protocol host username))
#t
private/git-commands.rkt
+9 -3
View File
@@ -106,13 +106,19 @@
(with-handlers
((exn:fail:git-auth?
(λ (e)
(if (and authentication-retry?
((current-git-authentication-handler) cmd nargs e))
(if authentication-retry?
(if ((current-git-authentication-handler) cmd nargs e)
(retry #f)
(git-error cmd
(format "Exitcode <> 0: ~a"
(exn:fail:git-auth-exit-code e))
(exn:fail:git-auth-output e))))))
(exn:fail:git-auth-output e)))
(begin
(reject-git-authentication cmd nargs)
(git-error cmd
(format "Exitcode <> 0: ~a"
(exn:fail:git-auth-exit-code e))
(exn:fail:git-auth-output e)))))))
(let-values (((exit-code output) (run-git (cons cmd nargs))))
(when (authentication-failure? exit-code output)
(raise-git-auth-error cmd nargs exit-code output))
private/utils.rkt
+18 -1
View File
@@ -6,6 +6,24 @@
valid-http-or-file-url?
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Ask the user for input .
; pre : p is a prompt.
; post : It should give back the supplied input as string.
; result : the return value of until.
; internals:
;
; input-prompt displays the given prompt and reads a line
; of text. After the user presses enter, this line is
; fed to the until callback. If the until callback returns
; #f, the prompt is displayed again. Otherwise, the value
; of until is returned.
;
; The programmer must make sure the until returns whatever
; format is appropriate. In general it will be a string.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (input-prompt p #:loop-until [until (λ (x) x)])
(let loop ()
(display p)
@@ -20,7 +38,6 @@
)
(define (valid-http-or-file-url? value)
(if (not (string? value))
#f
scribblings/git-cli.scrbl
+9 -7
View File
@@ -329,8 +329,7 @@ the @racket[exn:fail:git-auth] exception.
The callback returns a true value when it has handled authentication and the
original Git command should be tried again. A command is retried at most once.
The default callback returns @racket[#f], preserving the normal Git error
behavior.
The default callback is @racket[default-git-authentication-handler].
@racketblock[
(current-git-authentication-handler
@@ -370,11 +369,14 @@ failed Git process.
[args list?]
[e exn:fail:git-auth?])
boolean?]{
Handles one authentication failure. An existing Git credential helper is tried
first. If no helper is configured, git-cli requests a username and
password/token using @racket[input-prompt], configures Git's non-persistent
@tt{cache} credential helper locally, approves the credential, and returns
@racket[#t] so the original command can be retried once.
Handles one authentication failure. A credential that already failed is first
rejected. An existing Git credential helper is then asked for a replacement
credential. If that does not succeed, git-cli requests a username and
password/token using @racket[input-prompt]. Its @racket[#:loop-until] callbacks
both validate the input and return the value that is used. If no helper is
configured, Git's non-persistent @tt{cache} helper is configured locally before
the credential is approved. The original command is retried once; a credential
that fails on the retry is rejected before the Git error is raised.
}
@defparam[current-git-authentication-handler handler procedure?]{