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

First implementation of authentication handling

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-13 17:03:48 +02:00
parent c90c407dce
commit 73084e69d9
6 changed files with 162 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files
README.md
+17
View File
@@ -63,3 +63,20 @@ needed. Optional text can be supplied to Git with `#:input`.
The result remains two values: Git's exit code and the ordered
`(source line)` output items.
## Authentication retry
Authentication failures are detected centrally after `run-git`, before
command-specific result processing. `current-git-authentication-handler`
contains a callback that receives the command, processed arguments and an
`exn:fail:git-auth` value. If the callback handles authentication and returns a
true value, git-cli retries the original command once. The default callback
returns `#f`, so existing error behavior is preserved until an authentication
handler is configured.
```racket
(current-git-authentication-handler
(λ (cmd args e)
;; Perform credential handling here.
#t))
```
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.4")
(define version "0.3.18")
(define pkg-authors '("Hans Dijkema"))
(define license 'MIT)
main.rkt
+6
View File
@@ -30,6 +30,12 @@
git-help
git-version
git-new-version
current-git-authentication-handler
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
(all-from-out "private/diff.rkt")
)
private/git-auth.rkt
+67
View File
@@ -0,0 +1,67 @@
#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)))
private/git-commands.rkt
+25 -4
View File
@@ -1,6 +1,7 @@
#lang racket/base
(require "git-provider.rkt"
"git-auth.rkt"
racket/string
racket/list
)
@@ -9,6 +10,12 @@
check-git-args
has-git-arg?
std-process-git-result
current-git-authentication-handler
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
)
@@ -83,7 +90,8 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Define the internal proxy for a Git command.
; pre : pre-code and process-result accept the command proxy arguments.
; post : The proxy invokes Git without standard input and processes its result.
; post : Authentication failures are offered once to the current authentication
; handler before the Git command is retried.
; result : A procedure named f accepting a list of Git arguments.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-syntax def-git-cmd-proxy
@@ -93,8 +101,21 @@
(let* ((args (flatten args*))
(info (make-hash))
(nargs (pre-code args info)))
(let-values (((exit-code output) (run-git (cons cmd nargs))))
(let-values (((result out) (git-out cmd output)))
(process-result cmd exit-code result output out info))))))
(let retry ((authentication-retry? #t))
(with-handlers
((exn:fail:git-auth?
(λ (e)
(if (and authentication-retry?
((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))))))
(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))
(let-values (((result out) (git-out cmd output)))
(process-result cmd exit-code result output out info))))))))
)
)
scribblings/git.scrbl
+46
View File
@@ -269,3 +269,49 @@ where each item identifies either @racket['stdout] or @racket['stderr].
#:input "protocol=https\nhost=git.dijkewijk.nl\n\n")
]
}
@section{Authentication retry}
Git commands recognize common authentication failures immediately after the
Git process finishes and before command-specific result processing takes
place. Such a failure is represented by @racket[exn:fail:git-auth?].
@defparam[current-git-authentication-handler handler procedure?]{
Controls the callback used when an authentication failure is detected. The
callback receives the Git command symbol, the processed Git argument list and
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.
@racketblock[
(current-git-authentication-handler
(lambda (cmd args e)
;; Perform credential handling here.
#t))
]
}
@defproc[(exn:fail:git-auth? [v any/c]) boolean?]{
Recognizes the authentication exception used internally by git-cli.
}
@defproc[(exn:fail:git-auth-command [e exn:fail:git-auth?]) symbol?]{
Returns the Git command of the failed invocation.
}
@defproc[(exn:fail:git-auth-args [e exn:fail:git-auth?]) list?]{
Returns the processed Git arguments of the failed invocation.
}
@defproc[(exn:fail:git-auth-exit-code [e exn:fail:git-auth?]) exact-integer?]{
Returns Git's exit code.
}
@defproc[(exn:fail:git-auth-output [e exn:fail:git-auth?]) list?]{
Returns the ordered @racket['stdout]/@racket['stderr] output items from the
failed Git process.
}