From d9293df7801aa6086b523c969539f43dab50099a Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 23 Jun 2020 10:23:22 -0600 Subject: [PATCH] raco pkg config: warn about irrelevant default-scope The default package scope is determined by consulting the user-scope configuration, then falling back to the installation-scope configuration, then defaulting to user. So, if you have a user-scope configuration of `default-scope`, it doesn't matter what the configuration says in other scopes, which means that the output of `raco pkg config` can be confusing. Extra output in this commit is intended to make it less confusing. Probably the original mistake here was allowing `default-scope` at a scope-specific layer, instead of having it just as an installation configuration (like `name`). --- pkgs/racket-doc/pkg/scribblings/lib.scrbl | 29 +++++- pkgs/racket-doc/pkg/scribblings/pkg.scrbl | 5 + racket/collects/pkg/lib.rkt | 6 +- racket/collects/pkg/main.rkt | 10 +- racket/collects/pkg/private/config.rkt | 115 +++++++++++++++------- 5 files changed, 125 insertions(+), 40 deletions(-) diff --git a/pkgs/racket-doc/pkg/scribblings/lib.scrbl b/pkgs/racket-doc/pkg/scribblings/lib.scrbl index 3d9f34538d..f0a1351d4e 100644 --- a/pkgs/racket-doc/pkg/scribblings/lib.scrbl +++ b/pkgs/racket-doc/pkg/scribblings/lib.scrbl @@ -221,7 +221,8 @@ needed, and a list of module paths provided by the package.} @defproc[(pkg-config [set? boolean?] [keys/vals list?] - [#:from-command-line? from-command-line? boolean? #f]) + [#:from-command-line? from-command-line? boolean? #f] + [#:default-scope-scope default-scope-scope (or/c #f 'installation 'user (and/c path? complete-path?)) #f]) void?]{ Implements @racket[pkg-config-command]. @@ -229,8 +230,17 @@ Implements @racket[pkg-config-command]. If @racket[from-command-line?] is true, error messages may suggest specific command-line flags for @command-ref{config}. +If @racket[default-scope-scope] is not @racket[#f], then it specifies +potentially narrower scope than @racket[(current-pkg-scope)] where +@racket['default-scope] is configured. That information may trigger +output to warn a user that a @racket['default-scope] setting in a +wider scope does not have any effect. See also +@racket[pkg-config-default-scope-scope]. + The package lock must be held (allowing writes if @racket[set?] is true); see -@racket[with-pkg-lock].} +@racket[with-pkg-lock]. + +@history[#:changed "7.7.0.9" @elem{Added the @racket[#:default-scope-scope] argument.}]} @defproc[(pkg-create [format (or/c 'zip 'tgz 'plt 'MANIFEST)] @@ -743,3 +753,18 @@ platform-specific installations as determined by files. @history[#:added "6.0.1.13"]} + + +@defproc[(pkg-config-default-scope-scope) (or/c #f 'user 'installation (and/c path? complete-path?))]{ + +Reports the narrowest scope that is at least as wide as +@racket[current-pkg-scope] and that has a configuration for +@racket['default-scope]. The result can be useful with +@racket[pkg-config]. + +The package lock must be held; see @racket[with-pkg-lock]. Note that +@racket[pkg-config] cannot necessarily call +@racket[pkg-config-default-scope-scope] itself, because it may be +called with a lock that is wider than the narrowest relevant scope. + +@history[#:added "7.7.0.9"]} diff --git a/pkgs/racket-doc/pkg/scribblings/pkg.scrbl b/pkgs/racket-doc/pkg/scribblings/pkg.scrbl index e363b7f875..5b17b659dc 100644 --- a/pkgs/racket-doc/pkg/scribblings/pkg.scrbl +++ b/pkgs/racket-doc/pkg/scribblings/pkg.scrbl @@ -419,6 +419,11 @@ scope}. Search then proceeds in a configured order, where @exec{installation} @tech{package scope} typically precedes other directory @tech{package scopes}. +The default package scope is determined by first checking the +configuration at @racket['user] scope, and then checking for +configuration in wider scopes like @racket['installation]. If the +default package scope is not configured in any scope, then it defaults +to @racket['user]. @; ---------------------------------------- diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt index e132a9d1e5..e1782559fd 100644 --- a/racket/collects/pkg/lib.rkt +++ b/racket/collects/pkg/lib.rkt @@ -85,8 +85,12 @@ pkg-desc?)] [pkg-config (->* (boolean? (listof string?)) - (#:from-command-line? boolean?) + (#:from-command-line? boolean? + #:default-scope-scope (or/c package-scope/c #f)) void?)] + [pkg-config-default-scope-scope + (->* () + (or/c package-scope/c #f))] [pkg-new (-> path-string? void?)] [pkg-create diff --git a/racket/collects/pkg/main.rkt b/racket/collects/pkg/main.rkt index c896a10be2..3093561ae2 100644 --- a/racket/collects/pkg/main.rkt +++ b/racket/collects/pkg/main.rkt @@ -541,6 +541,10 @@ scope-flags ... #:handlers (lambda (accum . key+vals) + (define default-scope-scope (and (terminal-port? (current-output-port)) + (parameterize ([current-pkg-scope 'user]) + (with-pkg-lock/read-only + (pkg-config-default-scope-scope))))) (call-with-package-scope 'config scope scope-dir installation user #f #f #f #f @@ -548,10 +552,12 @@ (if set (with-pkg-lock (pkg-config #t key+vals - #:from-command-line? #t)) + #:from-command-line? #t + #:default-scope-scope default-scope-scope)) (with-pkg-lock/read-only (pkg-config #f key+vals - #:from-command-line? #t)))))) + #:from-command-line? #t + #:default-scope-scope default-scope-scope)))))) (list "key" "val")] ;; ---------------------------------------- [catalog-show diff --git a/racket/collects/pkg/private/config.rkt b/racket/collects/pkg/private/config.rkt index 375a0d1b7d..5af15a82b7 100644 --- a/racket/collects/pkg/private/config.rkt +++ b/racket/collects/pkg/private/config.rkt @@ -47,13 +47,23 @@ (pkg-error "only 'basic credentials are supported")) (cdr format+creds)) -(define (read-pkg-cfg/def k) +;; Must hold lock for current scope +(define (read-pkg-cfg/def key) + (read-pkg-cfg/def/scope key (lambda (v scope) v))) + +;; Must hold lock for current scope +(define (read-pkg-cfg-effective-scope key) + (read-pkg-cfg/def/scope key (lambda (v scope) scope))) + +;; `k` receives value and scope where it was found +(define (read-pkg-cfg/def/scope key k) ;; Lock is held for the current scope, but if ;; the key is not found in the current scope, ;; get the next scope's lock and try there, - ;; etc. + ;; etc., based on the rule that we can look + ;; wider with a given lock (define (get-default) - (match k + (match key ['catalogs (list "https://pkgs.racket-lang.org" "https://planet-compats.racket-lang.org")] @@ -69,36 +79,50 @@ ['git-checkout-credentials '(basic)] [_ #f])) (define c (read-pkg-file-hash (pkg-config-file))) - (define v (hash-ref c k 'none)) + (define v (hash-ref c key 'none)) (cond [(eq? v 'none) ;; Default from enclosing scope or hard-wired default: (define s (current-pkg-scope)) - (if (eq? s 'installation) - ;; Hard-wided: - (get-default) - ;; Enclosing: - (parameterize ([current-pkg-scope 'installation]) - (read-pkg-cfg/def k)))] + (define all-scopes (get-all-pkg-scopes)) + ;; We want to search all scopes before the current one in `all-scopes`. + ;; Instead of `reverse` plus `member`, this loop handles a path + ;; appearing multiple times in the list (which is not a good configuration, + ;; but this approach is better than potentially looping forever: + (define check-scopes + (let loop ([scopes all-scopes] [accum '()]) + (cond + [(null? scopes) accum] + [(equal? s (car scopes)) accum] + [else (loop (cdr scopes) (cons (car scopes) accum))]))) + (cond + [(null? check-scopes) + ;; Use hard-wired default: + (k (get-default) #f)] + [else + ;; Enclosing: + (parameterize ([current-pkg-scope (car check-scopes)]) + (read-pkg-cfg/def/scope key k))])] [else - (match k - ['catalogs - ;; Replace #f with default URLs, relative path - ;; with absolute path: - (apply append (for/list ([i (in-list v)]) - (cond - [(not i) (get-default)] - [(regexp-match? #rx"^[a-z]+://" i) - (list i)] - [else - ;; If it doesn't look like a URL, then treat it as - ;; a path (potentially relative to the configuration file): - (list - (url->string - (path->url - (simple-form-path - (path->complete-path i (path->complete-path (pkg-dir #t)))))))])))] - [_ v])])) + (k (match key + ['catalogs + ;; Replace #f with default URLs, relative path + ;; with absolute path: + (apply append (for/list ([i (in-list v)]) + (cond + [(not i) (get-default)] + [(regexp-match? #rx"^[a-z]+://" i) + (list i)] + [else + ;; If it doesn't look like a URL, then treat it as + ;; a path (potentially relative to the configuration file): + (list + (url->string + (path->url + (simple-form-path + (path->complete-path i (path->complete-path (pkg-dir #t)))))))])))] + [_ v]) + (current-pkg-scope))])) (define (update-pkg-cfg! key val) (define f (pkg-config-file)) @@ -121,10 +145,22 @@ (or (current-pkg-catalogs) (map string->url (read-pkg-cfg/def 'catalogs)))) -;; ---------------------------------------- +(define (narrower-scope? scope than-scope) + (define all-scopes (get-all-pkg-scopes)) + (and (member scope (cdr (or (member than-scope all-scopes) + '(#f)))) + #t)) +;; Makes the most sense when `(current-pkg-scope)` is 'user, +;; and a read lock must be held for the current scope. +(define (pkg-config-default-scope-scope) + (read-pkg-cfg-effective-scope 'default-scope)) + +;; ---------------------------------------- + (define (pkg-config config:set key+vals - #:from-command-line? [from-command-line? #f]) + #:from-command-line? [from-command-line? #f] + #:default-scope-scope [default-scope-scope #f]) (cond [config:set (match key+vals @@ -175,10 +211,14 @@ " valid values: installation, user") key val)) - (update-pkg-cfg! 'default-scope val)] + (update-pkg-cfg! 'default-scope val) + (when (and default-scope-scope + (narrower-scope? default-scope-scope (current-pkg-scope))) + (printf " Note: setting `default-scope` in ~a scope is not effective,\n" (current-pkg-scope)) + (printf " because `default-scope` is configured in a narrower scope\n"))] [(list (and key "name") val) (unless (eq? 'installation (current-pkg-scope)) - (pkg-error (~a "setting `name' makes sense only in `installation' scope\n" + (pkg-error (~a "setting `name` makes sense only ininstallation scope\n" " current package scope: ~a") (current-pkg-scope))) (update-pkg-cfg! 'installation-name val)] @@ -204,7 +244,7 @@ (update-pkg-cfg! (string->symbol key) (string->number val))] [(list (and key "doc-open-url") val) (unless (eq? 'installation (current-pkg-scope)) - (pkg-error (~a "setting `doc-open-url' works only in `installation' scope\n" + (pkg-error (~a "setting `doc-open-url` works only in `installation` scope\n" " current package scope: ~a") (current-pkg-scope))) (update-pkg-cfg! 'doc-open-url (if (equal? val "") #f val))] @@ -249,7 +289,12 @@ (for ([s (in-list (read-pkg-cfg/def 'catalogs))]) (printf "~a~a\n" indent s))] ["default-scope" - (printf "~a~a\n" indent (read-pkg-cfg/def 'default-scope))] + (define val (read-pkg-cfg/def 'default-scope)) + (printf "~a~a\n" indent val) + (when (and default-scope-scope + (narrower-scope? default-scope-scope (current-pkg-scope))) + (printf "~a Note: `default-scope` in ~a scope is not effective,\n" indent (current-pkg-scope)) + (printf "~a because `default-scope` is configured in a narrower scope\n" indent))] ["name" (printf "~a~a\n" indent (read-pkg-cfg/def 'installation-name))] [(or "download-cache-dir" @@ -271,7 +316,7 @@ [_ (pkg-error (~a "multiple config keys provided" (if from-command-line? - ";\n supply `--set' to set a config key's value" + ";\n supply `--set` to set a config key's value" "")))])) (match key+vals [(list)