summaryrefslogtreecommitdiff
path: root/guix/scripts
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-09-07 11:04:44 +0200
committerLudovic Courtès <ludo@gnu.org>2021-09-07 14:19:08 +0200
commitd9dfbf886ddbb92dfdaa118bb9765e78aad5c53a (patch)
tree2732020de20a38c09b66a60b0cb36022799f7c2e /guix/scripts
parentb949f34f31a045eb0fb242b81a223178fb6994d3 (diff)
parent49922efb11da0f0e9d4f5979d081de5ea8c99d25 (diff)
downloadguix-patches-d9dfbf886ddbb92dfdaa118bb9765e78aad5c53a.tar
guix-patches-d9dfbf886ddbb92dfdaa118bb9765e78aad5c53a.tar.gz
Merge branch 'master' into core-updates-frozen
Diffstat (limited to 'guix/scripts')
-rw-r--r--guix/scripts/import.scm3
-rw-r--r--guix/scripts/import/gem.scm3
-rw-r--r--guix/scripts/import/go.scm6
-rw-r--r--guix/scripts/import/minetest.scm117
-rw-r--r--guix/scripts/import/opam.scm8
-rw-r--r--guix/scripts/publish.scm21
-rw-r--r--guix/scripts/system.scm20
-rw-r--r--guix/scripts/system/reconfigure.scm22
-rw-r--r--guix/scripts/weather.scm22
9 files changed, 171 insertions, 51 deletions
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm
index f53d1ac1f4..b369a362d0 100644
--- a/guix/scripts/import.scm
+++ b/guix/scripts/import.scm
@@ -77,7 +77,8 @@ rather than \\n."
;;;
(define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa"
- "gem" "go" "cran" "crate" "texlive" "json" "opam"))
+ "gem" "go" "cran" "crate" "texlive" "json" "opam"
+ "minetest"))
(define (resolve-importer name)
(let ((module (resolve-interface
diff --git a/guix/scripts/import/gem.scm b/guix/scripts/import/gem.scm
index 65d2bf10b4..328d20b946 100644
--- a/guix/scripts/import/gem.scm
+++ b/guix/scripts/import/gem.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -60,7 +61,7 @@ Import and convert the RubyGems package for PACKAGE-NAME.\n"))
(exit 0)))
(option '(#\V "version") #f #f
(lambda args
- (show-version-and-exit "guix import pypi")))
+ (show-version-and-exit "guix import gem")))
(option '(#\r "recursive") #f #f
(lambda (opt name arg result)
(alist-cons 'recursive #t result)))
diff --git a/guix/scripts/import/go.scm b/guix/scripts/import/go.scm
index e08a1e427e..f5cfea8683 100644
--- a/guix/scripts/import/go.scm
+++ b/guix/scripts/import/go.scm
@@ -112,10 +112,10 @@ that are not yet in Guix"))
(map package->definition*
(apply go-module-recursive-import arguments))
;; Single import.
- (let ((sexp (apply go-module->guix-package arguments)))
+ (let ((sexp (apply go-module->guix-package* arguments)))
(unless sexp
- (leave (G_ "failed to download meta-data for module '~a'~%")
- module-name))
+ (leave (G_ "failed to download meta-data for module '~a'.~%")
+ name))
(package->definition* sexp))))))
(()
(leave (G_ "too few arguments~%")))
diff --git a/guix/scripts/import/minetest.scm b/guix/scripts/import/minetest.scm
new file mode 100644
index 0000000000..5f204d90fc
--- /dev/null
+++ b/guix/scripts/import/minetest.scm
@@ -0,0 +1,117 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 David Thompson <davet@gnu.org>
+;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix scripts import minetest)
+ #:use-module (guix ui)
+ #:use-module (guix utils)
+ #:use-module (guix scripts)
+ #:use-module (guix import minetest)
+ #:use-module (guix import utils)
+ #:use-module (guix scripts import)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-37)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 format)
+ #:export (guix-import-minetest))
+
+
+;;;
+;;; Command-line options.
+;;;
+
+(define %default-options
+ `((sort . ,%default-sort-key)))
+
+(define (show-help)
+ (display (G_ "Usage: guix import minetest AUTHOR/NAME
+Import and convert the Minetest mod NAME by AUTHOR from ContentDB.\n"))
+ (display (G_ "
+ -h, --help display this help and exit"))
+ (display (G_ "
+ -r, --recursive import packages recursively"))
+ (display (G_ "
+ -V, --version display version information and exit"))
+ (display (G_ "
+ --sort=KEY when choosing between multiple implementations,
+ choose the one with the highest value for KEY
+ (one of \"score\" (standard) or \"downloads\")"))
+ (newline)
+ (show-bug-report-information))
+
+(define (verify-sort-order sort)
+ "Verify SORT can be used to sort mods by."
+ (unless (member sort '("score" "downloads" "reviews"))
+ (leave (G_ "~a: not a valid key to sort by~%") sort))
+ sort)
+
+(define %options
+ ;; Specification of the command-line options.
+ (cons* (option '(#\h "help") #f #f
+ (lambda args
+ (show-help)
+ (exit 0)))
+ (option '(#\V "version") #f #f
+ (lambda args
+ (show-version-and-exit "guix import minetest")))
+ (option '(#\r "recursive") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'recursive #t result)))
+ (option '("sort") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'sort (verify-sort-order arg) result)))
+ %standard-import-options))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-import-minetest . args)
+ (define (parse-options)
+ ;; Return the alist of option values.
+ (args-fold* args %options
+ (lambda (opt name arg result)
+ (leave (G_ "~A: unrecognized option~%") name))
+ (lambda (arg result)
+ (alist-cons 'argument arg result))
+ %default-options))
+
+ (let* ((opts (parse-options))
+ (args (filter-map (match-lambda
+ (('argument . value)
+ value)
+ (_ #f))
+ (reverse opts))))
+ (match args
+ ((name)
+ (with-error-handling
+ (let* ((sort (assoc-ref opts 'sort))
+ (author/name (elaborate-contentdb-name name #:sort sort)))
+ (if (assoc-ref opts 'recursive)
+ ;; Recursive import
+ (filter-map package->definition
+ (minetest-recursive-import author/name #:sort sort))
+ ;; Single import
+ (minetest->guix-package author/name #:sort sort)))))
+ (()
+ (leave (G_ "too few arguments~%")))
+ ((many ...)
+ (leave (G_ "too many arguments~%"))))))
diff --git a/guix/scripts/import/opam.scm b/guix/scripts/import/opam.scm
index 64164e7cc4..834ac34cb0 100644
--- a/guix/scripts/import/opam.scm
+++ b/guix/scripts/import/opam.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;; Copyright © 2021 Alice Brenon <alice.brenon@ens-lyon.fr>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -46,7 +47,8 @@ Import and convert the opam package for PACKAGE-NAME.\n"))
(display (G_ "
-r, --recursive import packages recursively"))
(display (G_ "
- --repo import packages from this opam repository"))
+ --repo import packages from this opam repository (name, URL or local path)
+ can be used more than once"))
(display (G_ "
-V, --version display version information and exit"))
(newline)
@@ -81,7 +83,9 @@ Import and convert the opam package for PACKAGE-NAME.\n"))
#:build-options? #f))
(let* ((opts (parse-options))
- (repo (and=> (assoc-ref opts 'repo) string->symbol))
+ (repo (filter-map (match-lambda
+ (('repo . name) name)
+ (_ #f)) opts))
(args (filter-map (match-lambda
(('argument . value)
value)
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 913cbd4fda..25846b7dc2 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -4,6 +4,7 @@
;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2021 Mathieu Othacehe <othacehe@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -358,23 +359,13 @@ References: ~a~%"
compression)))
compressions)
hash size references))
- ;; Do not render a "Deriver" or "System" line if we are rendering
- ;; info for a derivation.
+ ;; Do not render a "Deriver" line if we are rendering info for a
+ ;; derivation. Also do not render a "System" line that would be
+ ;; expensive to compute and is currently unused.
(info (if (not deriver)
base-info
- (catch 'system-error
- (lambda ()
- (let ((drv (read-derivation-from-file deriver)))
- (format #f "~aSystem: ~a~%Deriver: ~a~%"
- base-info (derivation-system drv)
- (basename deriver))))
- (lambda args
- ;; DERIVER might be missing, but that's fine:
- ;; it's only used for <substitutable> where it's
- ;; optional. 'System' is currently unused.
- (if (= ENOENT (system-error-errno args))
- base-info
- (apply throw args))))))
+ (format #f "~aDeriver: ~a~%"
+ base-info (basename deriver))))
(signature (base64-encode-string
(canonical-sexp->string (signed-string info)))))
(format #f "~aSignature: 1;~a;~a~%" info (gethostname) signature)))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 40401d7e03..83bbefd3dc 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -253,7 +253,7 @@ the ownership of '~a' may be incorrect!~%")
#:target target)
(return
(info (G_ "bootloader successfully installed on '~a'~%")
- (bootloader-configuration-target bootloader))))))))
+ (bootloader-configuration-targets bootloader))))))))
;;;
@@ -768,14 +768,13 @@ and TARGET arguments."
skip-safety-checks?
install-bootloader?
dry-run? derivations-only?
- use-substitutes? bootloader-target target
+ use-substitutes? target
full-boot?
container-shared-network?
(mappings '())
(gc-root #f))
"Perform ACTION for IMAGE. INSTALL-BOOTLOADER? specifies whether to install
-bootloader; BOOTLOADER-TAGET is the target for the bootloader; TARGET is the
-target root directory.
+bootloader; TARGET is the target root directory.
FULL-BOOT? is used for the 'vm' action; it determines whether to
boot directly to the kernel or to the bootloader. CONTAINER-SHARED-NETWORK?
@@ -856,13 +855,13 @@ static checks."
#:target (or target "/"))
(return
(info (G_ "bootloader successfully installed on '~a'~%")
- (bootloader-configuration-target bootloader))))
+ (bootloader-configuration-targets bootloader))))
(with-shepherd-error-handling
- (upgrade-shepherd-services local-eval os)
- (return (format #t (G_ "\
+ (upgrade-shepherd-services local-eval os)
+ (return (format #t (G_ "\
To complete the upgrade, run 'herd restart SERVICE' to stop,
upgrade, and restart each service that was not automatically restarted.\n")))
- (return (format #t (G_ "\
+ (return (format #t (G_ "\
Run 'herd status' to view the list of services on your system.\n"))))))
((init)
(newline)
@@ -1218,9 +1217,9 @@ resulting from command-line parsing."
(target-file (match args
((first second) second)
(_ #f)))
- (bootloader-target
+ (bootloader-targets
(and bootloader?
- (bootloader-configuration-target
+ (bootloader-configuration-targets
(operating-system-bootloader os)))))
(define (graph-backend)
@@ -1269,7 +1268,6 @@ resulting from command-line parsing."
opts)
#:install-bootloader? bootloader?
#:target target-file
- #:bootloader-target bootloader-target
#:gc-root (assoc-ref opts 'gc-root)))))
#:target target
#:system system)))
diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index 49da6ecb16..bf23fb06af 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -207,10 +207,10 @@ services as defined by OS."
(define (install-bootloader-program installer disk-installer
bootloader-package bootcfg
- bootcfg-file device target)
+ bootcfg-file devices target)
"Return an executable store item that, upon being evaluated, will install
-BOOTCFG to BOOTCFG-FILE, a target file name, on DEVICE, a file system device,
-at TARGET, a mount point, and subsequently run INSTALLER from
+BOOTCFG to BOOTCFG-FILE, a target file name, on DEVICES, a list of file system
+devices, at TARGET, a mount point, and subsequently run INSTALLER from
BOOTLOADER-PACKAGE."
(program-file
"install-bootloader.scm"
@@ -254,11 +254,17 @@ BOOTLOADER-PACKAGE."
;; The bootloader might not support installation on a
;; mounted directory using the BOOTLOADER-INSTALLER
;; procedure. In that case, fallback to installing the
- ;; bootloader directly on DEVICE using the
+ ;; bootloader directly on DEVICES using the
;; BOOTLOADER-DISK-IMAGE-INSTALLER procedure.
(if #$installer
- (#$installer #$bootloader-package #$device #$target)
- (#$disk-installer #$bootloader-package 0 #$device)))
+ (for-each (lambda (device)
+ (#$installer #$bootloader-package device
+ #$target))
+ '#$devices)
+ (for-each (lambda (device)
+ (#$disk-installer #$bootloader-package
+ 0 device))
+ '#$devices)))
(lambda args
(delete-file new-gc-root)
(match args
@@ -284,7 +290,7 @@ additional configurations specified by MENU-ENTRIES can be selected."
(disk-installer (and run-installer?
(bootloader-disk-image-installer bootloader)))
(package (bootloader-package bootloader))
- (device (bootloader-configuration-target configuration))
+ (devices (bootloader-configuration-targets configuration))
(bootcfg-file (bootloader-configuration-file bootloader)))
(eval #~(parameterize ((current-warning-port (%make-void-port "w")))
(primitive-load #$(install-bootloader-program installer
@@ -292,7 +298,7 @@ additional configurations specified by MENU-ENTRIES can be selected."
package
bootcfg
bootcfg-file
- device
+ devices
target))))))
diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm
index 06312d65a2..60a697d1ac 100644
--- a/guix/scripts/weather.scm
+++ b/guix/scripts/weather.scm
@@ -54,16 +54,18 @@
(define (all-packages)
"Return the list of public packages we are going to query."
- (fold-packages (lambda (package result)
- (match (package-replacement package)
- ((? package? replacement)
- (cons* replacement package result))
- (#f
- (cons package result))))
- '()
-
- ;; Dismiss deprecated packages but keep hidden packages.
- #:select? (negate package-superseded)))
+ (delete-duplicates
+ (fold-packages (lambda (package result)
+ (match (package-replacement package)
+ ((? package? replacement)
+ (cons* replacement package result))
+ (#f
+ (cons package result))))
+ '()
+
+ ;; Dismiss deprecated packages but keep hidden packages.
+ #:select? (negate package-superseded))
+ eq?))
(define (call-with-progress-reporter reporter proc)
"This is a variant of 'call-with-progress-reporter' that works with monadic