First implementation of authentication handling

README.md

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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 retry ((authentication-retry? #t))
-           (let-values (((result out) (git-out cmd output)))
+           (with-handlers
-             (process-result cmd exit-code result output out info))))))
+               ((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

@@ -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.
+}
+