diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-09-17 16:17:20 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-09-17 16:27:15 +0200 |
commit | 9ff87bb99614923fa3336ab4bbf22e3444709b48 (patch) | |
tree | fa169a6cc0fdc8d92bb4c4a4f265afc2ba29a890 /guix/scripts | |
parent | ae71bef532d6b1c9d1481a3ac65827f148b1e45b (diff) | |
parent | 9e8e252026f558933bdd9cfc26a75d13954b3e8e (diff) | |
download | guix-patches-9ff87bb99614923fa3336ab4bbf22e3444709b48.tar guix-patches-9ff87bb99614923fa3336ab4bbf22e3444709b48.tar.gz |
Merge branch 'master' into core-updates
Diffstat (limited to 'guix/scripts')
-rw-r--r-- | guix/scripts/environment.scm | 13 | ||||
-rw-r--r-- | guix/scripts/gc.scm | 15 | ||||
-rw-r--r-- | guix/scripts/import/crate.scm | 13 | ||||
-rw-r--r-- | guix/scripts/pack.scm | 16 | ||||
-rw-r--r-- | guix/scripts/refresh.scm | 12 |
5 files changed, 58 insertions, 11 deletions
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index f7f7edda48..cfe0a37c42 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -463,6 +463,10 @@ host file systems to mount inside the container. If USER is not #f, each target of USER-MAPPINGS will be re-written relative to '/home/USER', and USER will be used for the passwd entry. LINK-PROFILE? creates a symbolic link from ~/.guix-profile to the environment profile." + (define (optional-mapping->fs mapping) + (and (file-exists? (file-system-mapping-source mapping)) + (file-system-mapping->bind-mount mapping))) + (mlet %store-monad ((reqs (inputs->requisites (list (direct-store-path bash) profile)))) (return @@ -499,11 +503,6 @@ will be used for the passwd entry. LINK-PROFILE? creates a symbolic link from (target cwd) (writable? #t))) '()))) - ;; When in Rome, do as Nix build.cc does: Automagically - ;; map common network configuration files. - (if network? - %network-file-mappings - '()) ;; Mappings for the union closure of all inputs. (map (lambda (dir) (file-system-mapping @@ -512,6 +511,10 @@ will be used for the passwd entry. LINK-PROFILE? creates a symbolic link from (writable? #f))) reqs))) (file-systems (append %container-file-systems + (if network? + (filter-map optional-mapping->fs + %network-file-mappings) + '()) (map file-system-mapping->bind-mount mappings)))) (exit/status diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm index 31657326b6..3f20a2e192 100644 --- a/guix/scripts/gc.scm +++ b/guix/scripts/gc.scm @@ -57,6 +57,8 @@ Invoke the garbage collector.\n")) (display (G_ " --list-roots list the user's garbage collector roots")) (display (G_ " + --list-busy list store items used by running processes")) + (display (G_ " --optimize optimize the store by deduplicating identical files")) (display (G_ " --list-dead list dead paths")) @@ -174,6 +176,10 @@ is deprecated; use '-D'~%")) (lambda (opt name arg result) (alist-cons 'action 'list-roots (alist-delete 'action result)))) + (option '("list-busy") #f #f + (lambda (opt name arg result) + (alist-cons 'action 'list-busy + (alist-delete 'action result)))) (option '("list-dead") #f #f (lambda (opt name arg result) (alist-cons 'action 'list-dead @@ -265,6 +271,12 @@ is deprecated; use '-D'~%")) (newline)) roots))) + (define (list-busy) + ;; List store items used by running processes. + (for-each (lambda (item) + (display item) (newline)) + (busy-store-items))) + (with-error-handling (let* ((opts (parse-options)) (store (open-connection)) @@ -305,6 +317,9 @@ is deprecated; use '-D'~%")) ((list-roots) (assert-no-extra-arguments) (list-roots)) + ((list-busy) + (assert-no-extra-arguments) + (list-busy)) ((delete) (delete-paths store (map direct-store-path paths))) ((list-references) diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm index cab9a4397b..7ae8638911 100644 --- a/guix/scripts/import/crate.scm +++ b/guix/scripts/import/crate.scm @@ -2,6 +2,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> +;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -75,6 +76,7 @@ Import and convert the crate.io package for PACKAGE-NAME.\n")) (alist-cons 'argument arg result)) %default-options)) + (let* ((opts (parse-options)) (args (filter-map (match-lambda (('argument . value) @@ -82,11 +84,16 @@ Import and convert the crate.io package for PACKAGE-NAME.\n")) (_ #f)) (reverse opts)))) (match args - ((package-name) - (let ((sexp (crate->guix-package package-name))) + ((spec) + (define-values (name version) + (package-name->name+version spec)) + + (let ((sexp (crate->guix-package name version))) (unless sexp (leave (G_ "failed to download meta-data for package '~a'~%") - package-name)) + (if version + (string-append name "@" version) + name))) sexp)) (() (leave (G_ "too few arguments~%"))) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index de5b3fc0ff..920d6c01fe 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -516,6 +516,18 @@ the image." `((directory "/tmp" ,(getuid) ,(getgid) #o1777) ,@(append-map symlink->directives '#$symlinks))) + (define tag + ;; Compute a meaningful "repository" name, which will show up in + ;; the output of "docker images". + (let ((manifest (profile-manifest #$profile))) + (let loop ((names (map manifest-entry-name + (manifest-entries manifest)))) + (define str (string-join names "-")) + (if (< (string-length str) 40) + str + (match names + ((_) str) + ((names ... _) (loop names))))))) ;drop one entry (setenv "PATH" (string-append #$archiver "/bin")) @@ -524,6 +536,7 @@ the image." (call-with-input-file "profile" read-reference-graph)) #$profile + #:repository tag #:database #+database #:system (or #$target (utsname:machine (uname))) #:environment environment @@ -944,7 +957,8 @@ Create a bundle of PACKAGE.\n")) (list (transform store package) output)) ((? package? package) (list (transform store package) "out"))) - (filter-map maybe-package-argument opts))) + (reverse + (filter-map maybe-package-argument opts)))) (manifest-file (assoc-ref opts 'manifest))) (define properties (if (assoc-ref opts 'save-provenance?) diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 4591d0f308..daf6fcf947 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -368,8 +368,16 @@ the latest known version of ~a (~a)~%") (upstream-source-version source))))))) (#f (when warn? - (warn-no-updater package))))) - + ;; Distinguish between "no updater" and "failing updater." + (match (lookup-updater package updaters) + ((? upstream-updater? updater) + (warning (package-location package) + (G_ "'~a' updater failed to determine available \ +releases for ~a~%") + (upstream-updater-name updater) + (package-name package))) + (#f + (warn-no-updater package))))))) ;;; |