suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkgs/racket-doc/pkg/scribblings/pkg.scrbl
View File

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

34
racket/collects/pkg/private/config.rkt
View File

@ -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"))])