diff options
Diffstat (limited to 'guix/scripts')
| -rw-r--r-- | guix/scripts/import/cran.scm | 7 | ||||
| -rw-r--r-- | guix/scripts/import/crate.scm | 5 | ||||
| -rw-r--r-- | guix/scripts/import/elpa.scm | 7 | ||||
| -rw-r--r-- | guix/scripts/import/gem.scm | 5 | ||||
| -rw-r--r-- | guix/scripts/import/hackage.scm | 5 | ||||
| -rw-r--r-- | guix/scripts/import/opam.scm | 5 | ||||
| -rw-r--r-- | guix/scripts/import/pypi.scm | 5 | ||||
| -rw-r--r-- | guix/scripts/import/stackage.scm | 5 | ||||
| -rw-r--r-- | guix/scripts/lint.scm | 8 | ||||
| -rw-r--r-- | guix/scripts/pack.scm | 21 | ||||
| -rw-r--r-- | guix/scripts/pull.scm | 1 | ||||
| -rw-r--r-- | guix/scripts/system.scm | 107 |
12 files changed, 127 insertions, 54 deletions
diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm index b6592f78a9..d6f371ef3a 100644 --- a/guix/scripts/import/cran.scm +++ b/guix/scripts/import/cran.scm @@ -27,7 +27,6 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-37) - #:use-module (srfi srfi-41) #:use-module (ice-9 match) #:use-module (ice-9 format) #:export (guix-import-cran)) @@ -98,10 +97,8 @@ Import and convert the CRAN package for PACKAGE-NAME.\n")) (if (assoc-ref opts 'recursive) ;; Recursive import (map package->definition - (reverse - (stream->list - (cran-recursive-import package-name - (or (assoc-ref opts 'repo) 'cran))))) + (cran-recursive-import package-name + (or (assoc-ref opts 'repo) 'cran))) ;; Single import (let ((sexp (cran->guix-package package-name (or (assoc-ref opts 'repo) 'cran)))) diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm index 4690cceb4d..92034dab3c 100644 --- a/guix/scripts/import/crate.scm +++ b/guix/scripts/import/crate.scm @@ -28,7 +28,6 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-37) - #:use-module (srfi srfi-41) #:use-module (ice-9 match) #:use-module (ice-9 format) #:export (guix-import-crate)) @@ -101,9 +100,7 @@ Import and convert the crate.io package for PACKAGE-NAME.\n")) `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (reverse - (stream->list - (crate-recursive-import name)))) + (crate-recursive-import name)) (let ((sexp (crate->guix-package name version))) (unless sexp (leave (G_ "failed to download meta-data for package '~a'~%") diff --git a/guix/scripts/import/elpa.scm b/guix/scripts/import/elpa.scm index f1ed5016ba..d270d2b4bc 100644 --- a/guix/scripts/import/elpa.scm +++ b/guix/scripts/import/elpa.scm @@ -27,7 +27,6 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-37) - #:use-module (srfi srfi-41) #:use-module (ice-9 match) #:use-module (ice-9 format) #:export (guix-import-elpa)) @@ -101,10 +100,8 @@ Import the latest package named PACKAGE-NAME from an ELPA repository.\n")) `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (reverse - (stream->list - (elpa-recursive-import package-name - (or (assoc-ref opts 'repo) 'gnu))))) + (elpa-recursive-import package-name + (or (assoc-ref opts 'repo) 'gnu))) (let ((sexp (elpa->guix-package package-name (assoc-ref opts 'repo)))) (unless sexp (leave (G_ "failed to download package '~a'~%") package-name)) diff --git a/guix/scripts/import/gem.scm b/guix/scripts/import/gem.scm index b6d9ccaae4..c64596b514 100644 --- a/guix/scripts/import/gem.scm +++ b/guix/scripts/import/gem.scm @@ -26,7 +26,6 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-37) - #:use-module (srfi srfi-41) #:use-module (ice-9 match) #:use-module (ice-9 format) #:export (guix-import-gem)) @@ -95,9 +94,7 @@ Import and convert the RubyGems package for PACKAGE-NAME.\n")) `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (reverse - (stream->list - (gem-recursive-import package-name 'rubygems)))) + (gem-recursive-import package-name 'rubygems)) (let ((sexp (gem->guix-package package-name))) (unless sexp (leave (G_ "failed to download meta-data for package '~a'~%") diff --git a/guix/scripts/import/hackage.scm b/guix/scripts/import/hackage.scm index f4aac61078..710e786a79 100644 --- a/guix/scripts/import/hackage.scm +++ b/guix/scripts/import/hackage.scm @@ -27,7 +27,6 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-37) - #:use-module (srfi srfi-41) #:use-module (ice-9 match) #:use-module (ice-9 format) #:export (guix-import-hackage)) @@ -130,9 +129,7 @@ version.\n")) `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (reverse - (stream->list - (apply hackage-recursive-import arguments)))) + (apply hackage-recursive-import arguments)) ;; Single import (apply hackage->guix-package arguments)))) (unless sexp (error-fn)) diff --git a/guix/scripts/import/opam.scm b/guix/scripts/import/opam.scm index 2d249a213f..20da1437fe 100644 --- a/guix/scripts/import/opam.scm +++ b/guix/scripts/import/opam.scm @@ -25,7 +25,6 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-37) - #:use-module (srfi srfi-41) #:use-module (ice-9 match) #:use-module (ice-9 format) #:export (guix-import-opam)) @@ -94,9 +93,7 @@ Import and convert the opam package for PACKAGE-NAME.\n")) `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (reverse - (stream->list - (opam-recursive-import package-name)))) + (opam-recursive-import package-name)) ;; Single import (let ((sexp (opam->guix-package package-name))) (unless sexp diff --git a/guix/scripts/import/pypi.scm b/guix/scripts/import/pypi.scm index 7bd83818ba..33167174e2 100644 --- a/guix/scripts/import/pypi.scm +++ b/guix/scripts/import/pypi.scm @@ -26,7 +26,6 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-37) - #:use-module (srfi srfi-41) #:use-module (ice-9 match) #:use-module (ice-9 format) #:export (guix-import-pypi)) @@ -95,9 +94,7 @@ Import and convert the PyPI package for PACKAGE-NAME.\n")) `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (reverse - (stream->list - (pypi-recursive-import package-name)))) + (pypi-recursive-import package-name)) ;; Single import (let ((sexp (pypi->guix-package package-name))) (unless sexp diff --git a/guix/scripts/import/stackage.scm b/guix/scripts/import/stackage.scm index b4b12581bf..d77328dcbf 100644 --- a/guix/scripts/import/stackage.scm +++ b/guix/scripts/import/stackage.scm @@ -27,7 +27,6 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-37) - #:use-module (srfi srfi-41) #:use-module (ice-9 match) #:use-module (ice-9 format) #:export (guix-import-stackage)) @@ -110,9 +109,7 @@ Import and convert the LTS Stackage package for PACKAGE-NAME.\n")) `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (reverse - (stream->list - (apply stackage-recursive-import arguments)))) + (apply stackage-recursive-import arguments)) ;; Single import (apply stackage->guix-package arguments)))) (unless sexp (error-fn)) diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 1668d02992..8d08c484f5 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -9,6 +9,7 @@ ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2017, 2018 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2019 Simon Tournier <zimon.toutoune@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -30,6 +31,7 @@ #:use-module (guix lint) #:use-module (guix ui) #:use-module (guix scripts) + #:use-module (guix scripts build) #:use-module (gnu packages) #:use-module (ice-9 match) #:use-module (ice-9 format) @@ -94,6 +96,9 @@ run the checkers on all packages.\n")) -c, --checkers=CHECKER1,CHECKER2... only run the specified checkers")) (display (G_ " + -L, --load-path=DIR prepend DIR to the package module search path")) + (newline) + (display (G_ " -h, --help display this help and exit")) (display (G_ " -l, --list-checkers display the list of available lint checkers")) @@ -128,6 +133,9 @@ run the checkers on all packages.\n")) %local-checkers (alist-delete 'checkers result)))) + (find (lambda (option) + (member "load-path" (option-names option))) + %standard-build-options) (option '(#\h "help") #f #f (lambda args (show-help) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 61d18e2609..bbacc93bc0 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -334,6 +334,16 @@ added to the pack." (define environment (singularity-environment-file profile)) + (define symlinks* + ;; Singularity requires /bin (specifically /bin/sh), so ensure that + ;; symlink is created. + (if (find (match-lambda + (("/bin" . _) #t) + (_ #f)) + symlinks) + symlinks + `(("/bin" -> "bin") ,@symlinks))) + (define build (with-imported-modules (source-module-closure '((guix build utils) @@ -407,7 +417,7 @@ added to the pack." "s" "777" "0" "0" (relative-file-name (dirname source) target))))))) - '#$symlinks) + '#$symlinks*) "-p" "/.singularity.d d 555 0 0" @@ -1049,9 +1059,18 @@ Create a bundle of PACKAGE.\n")) (entry-point (assoc-ref opts 'entry-point)) (profile-name (assoc-ref opts 'profile-name)) (gc-root (assoc-ref opts 'gc-root))) + (define (lookup-package package) + (manifest-lookup manifest (manifest-pattern (name package)))) + (when (null? (manifest-entries manifest)) (warning (G_ "no packages specified; building an empty pack~%"))) + (when (and (eq? pack-format 'squashfs) + (not (any lookup-package '("bash" "bash-minimal")))) + (warning (G_ "Singularity requires you to provide a shell~%")) + (display-hint (G_ "Add @code{bash} or @code{bash-minimal} \ +to your package list."))) + (run-with-store store (mlet* %store-monad ((profile (profile-derivation manifest diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 19410ad141..04cc51829d 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -60,6 +60,7 @@ #:use-module (ice-9 format) #:export (display-profile-content channel-list + channel-commit-hyperlink with-git-error-handling guix-pull)) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 5f0dce2093..3e9570753d 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -36,9 +36,11 @@ #:use-module (guix records) #:use-module (guix profiles) #:use-module (guix scripts) + #:use-module (guix channels) #:use-module (guix scripts build) #:autoload (guix scripts package) (delete-generations delete-matching-generations) + #:autoload (guix scripts pull) (channel-commit-hyperlink) #:use-module (guix graph) #:use-module (guix scripts graph) #:use-module (guix scripts system reconfigure) @@ -456,9 +458,30 @@ list of services." ;;; Generations. ;;; +(define (sexp->channel sexp) + "Return the channel corresponding to SEXP, an sexp as found in the +\"provenance\" file produced by 'provenance-service-type'." + (match sexp + (('channel ('name name) + ('url url) + ('branch branch) + ('commit commit)) + (channel (name name) (url url) + (branch branch) (commit commit))))) + (define* (display-system-generation number #:optional (profile %system-profile)) "Display a summary of system generation NUMBER in a human-readable format." + (define (display-channel channel) + (format #t " ~a:~%" (channel-name channel)) + (format #t (G_ " repository URL: ~a~%") (channel-url channel)) + (when (channel-branch channel) + (format #t (G_ " branch: ~a~%") (channel-branch channel))) + (format #t (G_ " commit: ~a~%") + (if (supports-hyperlinks?) + (channel-commit-hyperlink channel) + (channel-commit channel)))) + (unless (zero? number) (let* ((generation (generation-file-name profile number)) (params (read-boot-parameters-file generation)) @@ -468,7 +491,13 @@ list of services." (root-device (if (bytevector? root) (uuid->string root) root)) - (kernel (boot-parameters-kernel params))) + (kernel (boot-parameters-kernel params)) + (provenance (catch 'system-error + (lambda () + (call-with-input-file + (string-append generation "/provenance") + read)) + (const #f)))) (display-generation profile number) (format #t (G_ " file name: ~a~%") generation) (format #t (G_ " canonical file name: ~a~%") (readlink* generation)) @@ -495,7 +524,23 @@ list of services." (else root-device))) - (format #t (G_ " kernel: ~a~%") kernel)))) + (format #t (G_ " kernel: ~a~%") kernel) + + (match provenance + (#f #t) + (('provenance ('version 0) + ('channels channels ...) + ('configuration-file config-file)) + (unless (null? channels) + ;; TRANSLATORS: Here "channel" is the same terminology as used in + ;; "guix describe" and "guix pull --channels". + (format #t (G_ " channels:~%")) + (for-each display-channel (map sexp->channel channels))) + (when config-file + (format #t (G_ " configuration file: ~a~%") + (if (supports-hyperlinks?) + (file-hyperlink config-file) + config-file)))))))) (define* (list-generations pattern #:optional (profile %system-profile)) "Display in a human-readable format all the system generations matching @@ -722,7 +767,9 @@ and TARGET arguments." (return (primitive-eval (lowered-gexp-sexp lowered)))))) (define* (perform-action action os - #:key skip-safety-checks? + #:key + save-provenance? + skip-safety-checks? install-bootloader? dry-run? derivations-only? use-substitutes? bootloader-target target @@ -875,6 +922,8 @@ Some ACTIONS support additional ARGS.\n")) (display (G_ "\ roll-back switch to the previous operating system configuration\n")) (display (G_ "\ + describe describe the current system\n")) + (display (G_ "\ list-generations list the system generations\n")) (display (G_ "\ switch-generation switch to an existing operating system configuration\n")) @@ -918,16 +967,18 @@ Some ACTIONS support additional ARGS.\n")) (display (G_ " --no-bootloader for 'init', do not install a bootloader")) (display (G_ " + --save-provenance save provenance information")) + (display (G_ " --share=SPEC for 'vm', share host file system according to SPEC")) (display (G_ " + --expose=SPEC for 'vm', expose host file system according to SPEC")) + (display (G_ " -N, --network for 'container', allow containers to access the network")) (display (G_ " -r, --root=FILE for 'vm', 'vm-image', 'disk-image', 'container', and 'build', make FILE a symlink to the result, and register it as a garbage collector root")) (display (G_ " - --expose=SPEC for 'vm', expose host file system according to SPEC")) - (display (G_ " --full-boot for 'vm', make a full boot sequence")) (display (G_ " --skip-checks skip file system and initrd module safety checks")) @@ -979,6 +1030,9 @@ Some ACTIONS support additional ARGS.\n")) (option '("full-boot") #f #f (lambda (opt name arg result) (alist-cons 'full-boot? #t result))) + (option '("save-provenance") #f #f + (lambda (opt name arg result) + (alist-cons 'save-provenance? #t result))) (option '("skip-checks") #f #f (lambda (opt name arg result) (alist-cons 'skip-safety-checks? #t result))) @@ -1047,25 +1101,33 @@ resulting from command-line parsing." file-or-exp)) obj) + (define save-provenance? + (or (assoc-ref opts 'save-provenance?) + (memq action '(init reconfigure)))) + (let* ((file (match args (() #f) ((x . _) x))) (expr (assoc-ref opts 'expression)) (system (assoc-ref opts 'system)) (target (assoc-ref opts 'target)) - (os (ensure-operating-system - (or file expr) - (cond - ((and expr file) - (leave - (G_ "both file and expression cannot be specified~%"))) - (expr - (read/eval expr)) - (file - (load* file %user-module - #:on-error (assoc-ref opts 'on-error))) - (else - (leave (G_ "no configuration specified~%")))))) + (transform (if save-provenance? + (cut operating-system-with-provenance <> file) + identity)) + (os (transform + (ensure-operating-system + (or file expr) + (cond + ((and expr file) + (leave + (G_ "both file and expression cannot be specified~%"))) + (expr + (read/eval expr)) + (file + (load* file %user-module + #:on-error (assoc-ref opts 'on-error))) + (else + (leave (G_ "no configuration specified~%"))))))) (dry? (assoc-ref opts 'dry-run?)) (bootloader? (assoc-ref opts 'install-bootloader?)) @@ -1136,6 +1198,12 @@ argument list and OPTS is the option alist." ((pattern) pattern) (x (leave (G_ "wrong number of arguments~%")))))) (list-generations pattern))) + ((describe) + (match (generation-number %system-profile) + (0 + (error (G_ "no system generation, nothing to describe~%"))) + (generation + (display-system-generation generation)))) ((search) (apply (resolve-subcommand "search") args)) ;; The following commands need to use the store, but they do not need an @@ -1175,7 +1243,8 @@ argument list and OPTS is the option alist." (case action ((build container vm vm-image disk-image reconfigure init extension-graph shepherd-graph - list-generations delete-generations roll-back + list-generations describe + delete-generations roll-back switch-generation search docker-image) (alist-cons 'action action result)) (else (leave (G_ "~a: unknown action~%") action)))))) |