diff options
author | Marius Bakke <mbakke@fastmail.com> | 2019-09-27 19:11:27 +0200 |
---|---|---|
committer | Marius Bakke <mbakke@fastmail.com> | 2019-09-27 19:11:27 +0200 |
commit | e7f62a41b245ca30404c54f3f77930336627c2f7 (patch) | |
tree | 4b2a24dcc84f137b92ca581dba96cf7abac70439 /guix/scripts | |
parent | 1fdab9d3b3e78b0c90b52567be5535a861a7273d (diff) | |
parent | b48eb1e934f1d457ff6a0fec1c572bb12ed15fab (diff) | |
download | patches-e7f62a41b245ca30404c54f3f77930336627c2f7.tar patches-e7f62a41b245ca30404c54f3f77930336627c2f7.tar.gz |
Merge branch 'master' into core-updates
Diffstat (limited to 'guix/scripts')
-rw-r--r-- | guix/scripts/download.scm | 15 | ||||
-rw-r--r-- | guix/scripts/package.scm | 21 | ||||
-rw-r--r-- | guix/scripts/pull.scm | 2 |
3 files changed, 37 insertions, 1 deletions
diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm index d8fe71ce12..22cd75ea0b 100644 --- a/guix/scripts/download.scm +++ b/guix/scripts/download.scm @@ -33,6 +33,7 @@ #:use-module (web uri) #:use-module (ice-9 match) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-14) #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) #:use-module (rnrs bytevectors) @@ -54,9 +55,23 @@ (url-fetch url file #:mirrors %mirrors))) file)) +(define (ensure-valid-store-file-name name) + "Replace any character not allowed in a stror name by an underscore." + + (define valid + ;; according to nix/libstore/store-api.cc + (string->char-set (string-append "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyz" + "0123456789" "+-._?="))) + (string-map (lambda (c) + (if (char-set-contains? valid c) c #\_)) + name)) + + (define* (download-to-store* url #:key (verify-certificate? #t)) (with-store store (download-to-store store url + (ensure-valid-store-file-name (basename url)) #:verify-certificate? verify-certificate?))) (define %default-options diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index f03741aa9e..1a58d43e5c 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -39,6 +39,7 @@ #:use-module (guix scripts) #:use-module (guix scripts build) #:autoload (guix describe) (package-provenance) + #:autoload (guix store roots) (gc-roots) #:use-module ((guix build utils) #:select (directory-exists? mkdir-p)) #:use-module (ice-9 format) @@ -359,6 +360,8 @@ Install, remove, or upgrade packages in a single transaction.\n")) switch to a generation matching PATTERN")) (display (G_ " -p, --profile=PROFILE use PROFILE instead of the user's default profile")) + (display (G_ " + --list-profiles list the user's profiles")) (newline) (display (G_ " --allow-collisions do not treat collisions in the profile as an error")) @@ -458,6 +461,11 @@ command-line option~%") (values (cons `(query list-generations ,arg) result) #f))) + (option '("list-profiles") #f #f + (lambda (opt name arg result arg-handler) + (values (cons `(query list-profiles #t) + result) + #f))) (option '(#\d "delete-generations") #f #t (lambda (opt name arg result arg-handler) (values (alist-cons 'delete-generations arg @@ -750,6 +758,19 @@ processed, #f otherwise." (string<? name1 name2)))))) #t)) + (('list-profiles _) + (let ((profiles (delete-duplicates + (filter-map (lambda (root) + (and (or (zero? (getuid)) + (user-owned? root)) + (generation-profile root))) + (gc-roots))))) + (leave-on-EPIPE + (for-each (lambda (profile) + (display (user-friendly-profile profile)) + (newline)) + (sort profiles string<?))))) + (('search _) (let* ((patterns (filter-map (match-lambda (('query 'search rx) rx) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 2b7b991b50..0372278705 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -249,7 +249,7 @@ PORT." (channel-news-entry-body entry)) (display-news-entry-title entry language port) - (format port (G_ " commit ~a~%") + (format port (dim (G_ " commit ~a~%")) (channel-news-entry-commit entry)) (newline port) (format port " ~a~%" |