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

Make pkg git credential format extensible.

Browse Source 
Thanks to Eli.
This commit is contained in:
Vincent St-Amour 2016-10-07 14:17:31 -05:00
parent 456a72a36c
commit d597983bb9
2 changed files with 37 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -944,10 +944,12 @@ 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 @item{@exec{git-checkout-credentials} --- A list that starts with a format
@nonterm{username}@litchar{:}@nonterm{password} that are tried when downloading specification (currently only @racket['basic] is supported), followed
packages with git sources using the HTTP or HTTPS protocols. The credentials are by git credentials in the form @nonterm{username}@litchar{:}@nonterm{password}
currently stored @bold{unencrypted} on the filesystem.} that are tried when downloading packages with git sources using the
HTTP or HTTPS protocols. The credentials are currently stored
@bold{unencrypted} on the filesystem.}
@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

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

@ -39,8 +39,13 @@
(read-pkg-cfg/def 'network-retries))) (read-pkg-cfg/def 'network-retries)))
(define (get-git-checkout-credentials) (define (get-git-checkout-credentials)
(or (current-pkg-git-checkout-credentials) (define format+creds
(read-pkg-cfg/def 'git-checkout-credentials))) (or (current-pkg-git-checkout-credentials)
(read-pkg-cfg/def 'git-checkout-credentials)))
(define format-spec (car format+creds))
(unless (eq? format-spec 'basic)
(pkg-error "only 'basic credentials are supported"))
(cdr format+creds))
(define (read-pkg-cfg/def k) (define (read-pkg-cfg/def k)
;; Lock is held for the current scope, but if ;; Lock is held for the current scope, but if
@ -61,7 +66,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 '()] ['git-checkout-credentials '(basic)]
[_ #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))
@ -210,27 +215,28 @@
" expected: value in the form <username>:<password>") " expected: value in the form <username>:<password>")
val)) val))
(update-pkg-cfg! 'git-checkout-credentials (update-pkg-cfg! 'git-checkout-credentials
(for/list ([val (in-list vals)]) (cons 'basic
(match (string-split val ":" #:trim? #f) (for/list ([val (in-list vals)])
[(list "" _) (match (string-split val ":" #:trim? #f)
(credentials-format-error [(list "" _)
"invalid empty username in git checkout credentials" (credentials-format-error
val)] "invalid empty username in git checkout credentials"
[(list _ "") val)]
(credentials-format-error [(list _ "")
"invalid empty password in git checkout credentials" (credentials-format-error
val)] "invalid empty password in git checkout credentials"
[(list username password) val)]
`#hasheq((username . ,username) [(list username password)
(password . ,password))] `#hasheq((username . ,username)
[(list* _ _ _) (password . ,password))]
(credentials-format-error [(list* _ _ _)
"too many elements for git checkout credentials" (credentials-format-error
val)] "too many elements for git checkout credentials"
[(list _) val)]
(credentials-format-error [(list _)
"not enough elements for git checkout credentials" (credentials-format-error
val)]))) "not enough elements for git checkout credentials"
val)]))))
(displayln "WARNING: checkout credentials are stored UNENCRYPTED" (current-error-port))] (displayln "WARNING: checkout credentials are stored UNENCRYPTED" (current-error-port))]
[(list* key args) [(list* key args)
(pkg-error "unsupported config key\n key: ~a" key)])] (pkg-error "unsupported config key\n key: ~a" key)])]
@ -256,7 +262,7 @@
["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" ["git-checkout-credentials"
(for ([creds (in-list (read-pkg-cfg/def 'git-checkout-credentials))]) (for ([creds (in-list (cdr (read-pkg-cfg/def 'git-checkout-credentials)))])
(printf "~a~a:~a\n" indent (hash-ref creds 'username) (hash-ref creds 'password)))] (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)])]