diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2021-05-09 17:22:24 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2021-05-09 23:46:46 +0200 |
| commit | 8a154c29151fc445e8d0364f507f6e200de1e700 (patch) | |
| tree | bca633357bf0f0648e35268db00f50b1800b37b8 | |
| parent | 9562a2eb6162ea6712fe31529c30002a83313dd8 (diff) | |
describe: Gracefully handle profiles that lack provenance info.
Fixes <https://bugs.gnu.org/48313>.
Previously, 'current-channels' would return the empty list when
'current-profile' is true but the profile lacks provenance info.
* guix/describe.scm (current-channels)[build-time-metadata]: New
procedure. Call it when 'manifest-entry-channel' returns #f for all of
ENTRIES.
* guix/scripts/describe.scm (guix-describe): When PROFILE is true, pass
third argument to 'display-profile-info'.
| -rw-r--r-- | guix/describe.scm | 17 | ||||
| -rw-r--r-- | guix/scripts/describe.scm | 9 |
2 files changed, 21 insertions, 5 deletions
diff --git a/guix/describe.scm b/guix/describe.scm index 0683ad8a278..711b7b42903 100644 --- a/guix/describe.scm +++ b/guix/describe.scm | |||
| @@ -122,15 +122,24 @@ lives in, or the empty list if this is not applicable." | |||
| 122 | (mlambda () | 122 | (mlambda () |
| 123 | "Return the list of channels currently available, including the 'guix' | 123 | "Return the list of channels currently available, including the 'guix' |
| 124 | channel. Return the empty list if this information is missing." | 124 | channel. Return the empty list if this information is missing." |
| 125 | (define (build-time-metadata) | ||
| 126 | (match (channel-metadata) | ||
| 127 | (#f '()) | ||
| 128 | (sexp (or (and=> (sexp->channel sexp 'guix) list) '())))) | ||
| 129 | |||
| 125 | (match (current-profile-entries) | 130 | (match (current-profile-entries) |
| 126 | (() | 131 | (() |
| 127 | ;; As a fallback, if we're not running from a profile, use 'guix' | 132 | ;; As a fallback, if we're not running from a profile, use 'guix' |
| 128 | ;; channel metadata from (guix config). | 133 | ;; channel metadata from (guix config). |
| 129 | (match (channel-metadata) | 134 | (build-time-metadata)) |
| 130 | (#f '()) | ||
| 131 | (sexp (or (and=> (sexp->channel sexp 'guix) list) '())))) | ||
| 132 | (entries | 135 | (entries |
| 133 | (filter-map manifest-entry-channel entries))))) | 136 | (match (filter-map manifest-entry-channel entries) |
| 137 | (() | ||
| 138 | ;; This profile lacks provenance metadata, so fall back to | ||
| 139 | ;; build-time metadata as returned by 'channel-metadata'. | ||
| 140 | (build-time-metadata)) | ||
| 141 | (lst | ||
| 142 | lst)))))) | ||
| 134 | 143 | ||
| 135 | (define (package-path-entries) | 144 | (define (package-path-entries) |
| 136 | "Return two values: the list of package path entries to be added to the | 145 | "Return two values: the list of package path entries to be added to the |
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm index b5f6249176a..a3e3338f7e1 100644 --- a/guix/scripts/describe.scm +++ b/guix/scripts/describe.scm | |||
| @@ -301,4 +301,11 @@ text. The hyperlink links to a web view of COMMIT, when available." | |||
| 301 | (channels | 301 | (channels |
| 302 | (display-profile-info #f format channels)))) | 302 | (display-profile-info #f format channels)))) |
| 303 | (profile | 303 | (profile |
| 304 | (display-profile-info (canonicalize-profile profile) format)))))) | 304 | ;; For the current profile, resort to 'current-channels', which has a |
| 305 | ;; fallback to metadata from (guix config) in case PROFILE lacks it. | ||
| 306 | (let ((channels (if (and (current-profile) | ||
| 307 | (string=? profile (current-profile))) | ||
| 308 | (current-channels) | ||
| 309 | (profile-channels profile)))) | ||
| 310 | (display-profile-info (canonicalize-profile profile) | ||
| 311 | format channels))))))) | ||
