From 8de889df5ea3e0859cd01f1fcd39cdca5a7f949c Mon Sep 17 00:00:00 2001
From: Alexis King <lexi.lambda@gmail.com>
Date: Thu, 29 Sep 2016 10:22:38 -0700
Subject: [PATCH] Add support for the 'git-checkout-credentials raco config
 option

---
 pkgs/racket-doc/pkg/scribblings/pkg.scrbl |  6 +++-
 racket/collects/pkg/private/config.rkt    | 34 +++++++++++++++++++++++
 2 files changed, 39 insertions(+), 1 deletion(-)

diff --git a/pkgs/racket-doc/pkg/scribblings/pkg.scrbl b/pkgs/racket-doc/pkg/scribblings/pkg.scrbl
index fc0b6d328d..f09290e670 100644
--- a/pkgs/racket-doc/pkg/scribblings/pkg.scrbl
+++ b/pkgs/racket-doc/pkg/scribblings/pkg.scrbl
@@ -944,6 +944,9 @@ for @nonterm{key}.
         documentation; an empty string, which is the default, disables
         the URL so that the local filesystem is used. This key can be
         set only in @exec{installation} scope.}
+  @item{@exec{git-checkout-credentials} --- A list of git credentials in the form
+        @nonterm{username}@litchar{:}@nonterm{password} that are tried when downloading
+        packages with git sources using the HTTP or HTTPS protocols.}
   @item{@exec{trash-max-packages} --- A limit on the number of package implementations
         that are kept in a trash folder when the package is removed or updated.}
   @item{@exec{trash-max-seconds} --- A limit on the time since a package is removed or
@@ -955,7 +958,8 @@ for @nonterm{key}.
  ]
 
 @history[#:changed "6.1.1.6" @elem{Added @exec{trash-max-packages} and @exec{trash-max-seconds}.}
-         #:changed "6.3" @elem{Added @exec{network-retries}.}]}
+         #:changed "6.3" @elem{Added @exec{network-retries}.}
+         #:changed "6.6.0.5" @elem{Added @exec{git-checkout-credentials}.}]}
 
 
 @subcommand{@command/toc{catalog-show} @nonterm{option} ... @nonterm{package-name} ...
diff --git a/racket/collects/pkg/private/config.rkt b/racket/collects/pkg/private/config.rkt
index 994ce8fe1a..1296ad6a18 100644
--- a/racket/collects/pkg/private/config.rkt
+++ b/racket/collects/pkg/private/config.rkt
@@ -4,6 +4,7 @@
          racket/path
          racket/match
          racket/format
+         racket/string
          net/url
          "../path.rkt"
          "dirs.rkt"
@@ -56,6 +57,7 @@
       ['trash-max-packages 512]
       ['trash-max-seconds (* 60 60 24 2)] ; 2 days
       ['network-retries 5]
+      ['git-checkout-credentials '()]
       [_ #f]))
   (define c (read-pkg-file-hash (pkg-config-file)))
   (define v (hash-ref c k 'none))
@@ -197,6 +199,34 @@
                          "  current package scope: ~a")
                      (current-pkg-scope)))
         (update-pkg-cfg! 'doc-open-url (if (equal? val "") #f val))]
+       [(list* "git-checkout-credentials" vals)
+        (define (credentials-format-error msg val)
+          (pkg-error (~a msg "\n"
+                         "  given: ~a\n"
+                         "  expected: value in the form <username>:<password>")
+                     val))
+        (update-pkg-cfg! 'git-checkout-credentials
+                         (for/list ([val (in-list vals)])
+                           (match (string-split val ":" #:trim? #f)
+                             [(list "" _)
+                              (credentials-format-error
+                               "invalid empty username in git checkout credentials"
+                               val)]
+                             [(list _ "")
+                              (credentials-format-error
+                               "invalid empty password in git checkout credentials"
+                               val)]
+                             [(list username password)
+                              `#hasheq((username . ,username)
+                                       (password . ,password))]
+                             [(list* _ _ _)
+                              (credentials-format-error
+                               "too many elements for git checkout credentials"
+                               val)]
+                             [(list _)
+                              (credentials-format-error
+                               "not enough elements for git checkout credentials"
+                               val)])))]
        [(list* key args)
         (pkg-error "unsupported config key\n  key: ~a" key)])]
     [else
@@ -220,6 +250,9 @@
              (printf "~a~a\n" indent (read-pkg-cfg/def (string->symbol key)))]
             ["doc-open-url"
              (printf "~a~a\n" indent (or (read-pkg-cfg/def 'doc-open-url) ""))]
+            ["git-checkout-credentials"
+             (for ([creds (in-list (read-pkg-cfg/def 'git-checkout-credentials))])
+               (printf "~a~a:~a\n" indent (hash-ref creds 'username) (hash-ref creds 'password)))]
             [_
              (pkg-error "unsupported config key\n  key: ~e" key)])]
          [(list)
@@ -237,6 +270,7 @@
                               "download-cache-dir"
                               "download-cache-max-files"
                               "download-cache-max-bytes"
+                              "git-checkout-credentials"
                               "trash-max-packages"
                               "trash-max-seconds"
                               "network-retries"))])