Add support for the 'git-checkout-credentials raco config option

This commit is contained in:
Alexis King 2016-09-29 10:22:38 -07:00
parent d409fb5e2e
commit 8de889df5e
2 changed files with 39 additions and 1 deletions

View File

@ -944,6 +944,9 @@ for @nonterm{key}.
documentation; an empty string, which is the default, disables documentation; an empty string, which is the default, disables
the URL so that the local filesystem is used. This key can be the URL so that the local filesystem is used. This key can be
set only in @exec{installation} scope.} 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 @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.} 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 @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}.} @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} ... @subcommand{@command/toc{catalog-show} @nonterm{option} ... @nonterm{package-name} ...

View File

@ -4,6 +4,7 @@
racket/path racket/path
racket/match racket/match
racket/format racket/format
racket/string
net/url net/url
"../path.rkt" "../path.rkt"
"dirs.rkt" "dirs.rkt"
@ -56,6 +57,7 @@
['trash-max-packages 512] ['trash-max-packages 512]
['trash-max-seconds (* 60 60 24 2)] ; 2 days ['trash-max-seconds (* 60 60 24 2)] ; 2 days
['network-retries 5] ['network-retries 5]
['git-checkout-credentials '()]
[_ #f])) [_ #f]))
(define c (read-pkg-file-hash (pkg-config-file))) (define c (read-pkg-file-hash (pkg-config-file)))
(define v (hash-ref c k 'none)) (define v (hash-ref c k 'none))
@ -197,6 +199,34 @@
" current package scope: ~a") " current package scope: ~a")
(current-pkg-scope))) (current-pkg-scope)))
(update-pkg-cfg! 'doc-open-url (if (equal? val "") #f val))] (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) [(list* key args)
(pkg-error "unsupported config key\n key: ~a" key)])] (pkg-error "unsupported config key\n key: ~a" key)])]
[else [else
@ -220,6 +250,9 @@
(printf "~a~a\n" indent (read-pkg-cfg/def (string->symbol key)))] (printf "~a~a\n" indent (read-pkg-cfg/def (string->symbol key)))]
["doc-open-url" ["doc-open-url"
(printf "~a~a\n" indent (or (read-pkg-cfg/def '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)])] (pkg-error "unsupported config key\n key: ~e" key)])]
[(list) [(list)
@ -237,6 +270,7 @@
"download-cache-dir" "download-cache-dir"
"download-cache-max-files" "download-cache-max-files"
"download-cache-max-bytes" "download-cache-max-bytes"
"git-checkout-credentials"
"trash-max-packages" "trash-max-packages"
"trash-max-seconds" "trash-max-seconds"
"network-retries"))]) "network-retries"))])