summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
Diffstat (limited to 'guix')
-rw-r--r--guix/build-system/font.scm30
-rw-r--r--guix/build-system/mozilla.scm52
-rw-r--r--guix/build/font-build-system.scm8
-rw-r--r--guix/build/gnu-bootstrap.scm32
-rw-r--r--guix/build/minetest-build-system.scm9
-rw-r--r--guix/build/python-build-system.scm6
-rw-r--r--guix/build/qt-utils.scm10
-rw-r--r--guix/build/utils.scm35
-rw-r--r--guix/lint.scm1
-rw-r--r--guix/profiles.scm3
-rw-r--r--guix/scripts/home.scm3
-rw-r--r--guix/scripts/package.scm3
-rw-r--r--guix/scripts/system/reconfigure.scm4
-rw-r--r--guix/utils.scm8
14 files changed, 140 insertions, 64 deletions
diff --git a/guix/build-system/font.scm b/guix/build-system/font.scm
index 74dc80b5db..c43fb9a542 100644
--- a/guix/build-system/font.scm
+++ b/guix/build-system/font.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2017, 2022 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -54,20 +54,20 @@
(bag
(name name)
(system system)
- (host-inputs `(,@(if source
- `(("source" ,source))
- '())
- ,@inputs
- ,(list "tar" (module-ref (resolve-interface '(gnu packages base)) 'tar))
- ,@(let ((compression (resolve-interface '(gnu packages compression))))
- (map (match-lambda
- ((name package)
- (list name (module-ref compression package))))
- `(("gzip" gzip)
- ("bzip2" bzip2)
- ("unzip" unzip)
- ("xz" xz))))))
- (build-inputs native-inputs)
+ (host-inputs inputs)
+ (build-inputs `(,@(if source
+ `(("source" ,source))
+ '())
+ ,@native-inputs
+ ,(list "tar" (module-ref (resolve-interface '(gnu packages base)) 'tar))
+ ,@(let ((compression (resolve-interface '(gnu packages compression))))
+ (map (match-lambda
+ ((name package)
+ (list name (module-ref compression package))))
+ `(("gzip" gzip)
+ ("bzip2" bzip2)
+ ("unzip" unzip)
+ ("xz" xz))))))
(outputs outputs)
(build font-build)
(arguments (strip-keyword-arguments private-keywords arguments))))
diff --git a/guix/build-system/mozilla.scm b/guix/build-system/mozilla.scm
new file mode 100644
index 0000000000..bead1bf5bb
--- /dev/null
+++ b/guix/build-system/mozilla.scm
@@ -0,0 +1,52 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; 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 build-system mozilla)
+ #:use-module (guix build-system gnu)
+ #:use-module (guix build-system)
+ #:use-module (guix utils)
+ #:export (mozilla-build-system))
+
+;;
+;; Build procedure for packages using Autotools with the Mozillian conventions
+;; for --target, --host and --build, which are different from the GNU
+;; conventions.
+;;
+;; Code:
+
+(define* (lower-mozilla name #:key system target #:allow-other-keys
+ #:rest arguments)
+ (define lower (build-system-lower gnu-build-system))
+ (if target
+ (apply lower name
+ (substitute-keyword-arguments arguments
+ ;; Override --target and --host to what Mozillian configure
+ ;; scripts expect.
+ ((#:configure-flags configure-flags ''())
+ `(cons* ,(string-append "--target=" target)
+ ,(string-append "--host=" (nix-system->gnu-triplet system))
+ ,configure-flags))))
+ (apply lower name arguments))) ; not cross-compiling
+
+(define mozilla-build-system
+ (build-system
+ (name 'mozilla)
+ (description "The build system for Mozilla software using the Autotools")
+ (lower lower-mozilla)))
+
+;;; mozilla.scm ends here
diff --git a/guix/build/font-build-system.scm b/guix/build/font-build-system.scm
index 6726595fe1..e4784bc17d 100644
--- a/guix/build/font-build-system.scm
+++ b/guix/build/font-build-system.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2017, 2022 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2017 Alex Griffin <a@ajgrf.com>
;;;
;;; This file is part of GNU Guix.
@@ -41,8 +41,7 @@ archive, or a font file."
(begin
(mkdir "source")
(chdir "source")
- (copy-file source (strip-store-file-name source))
- #t)
+ (copy-file source (strip-store-file-name source)))
(gnu:unpack #:source source)))
(define* (install #:key outputs #:allow-other-keys)
@@ -54,7 +53,8 @@ archive, or a font file."
(find-files source "\\.(ttf|ttc)$"))
(for-each (cut install-file <> (string-append fonts "/opentype"))
(find-files source "\\.(otf|otc)$"))
- #t))
+ (for-each (cut install-file <> (string-append fonts "/web"))
+ (find-files source "\\.(woff|woff2)$"))))
(define %standard-phases
(modify-phases gnu:%standard-phases
diff --git a/guix/build/gnu-bootstrap.scm b/guix/build/gnu-bootstrap.scm
index 1cb9dc5512..b4257a3717 100644
--- a/guix/build/gnu-bootstrap.scm
+++ b/guix/build/gnu-bootstrap.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2020, 2022 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -25,17 +25,18 @@
(define-module (guix build gnu-bootstrap)
#:use-module (guix build utils)
+ #:use-module (srfi srfi-1)
#:use-module (system base compile)
#:export (bootstrap-configure
bootstrap-build
bootstrap-install))
-(define (bootstrap-configure version modules scripts)
+(define (bootstrap-configure name version modules scripts)
"Create a procedure that configures an early bootstrap package. The
-procedure will search the MODULES directory and configure all of the
-'.in' files with VERSION. It will then search the SCRIPTS directory and
-configure all of the '.in' files with the bootstrap Guile and its module
-and object directories."
+procedure will search each directory in MODULES and configure all of the
+'.in' files with NAME and VERSION. It will then search the SCRIPTS
+directory and configure all of the '.in' files with the bootstrap
+Guile and its module and object directories."
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(guile-dir (assoc-ref inputs "guile"))
@@ -50,10 +51,10 @@ and object directories."
(let ((target (string-drop-right template 3)))
(copy-file template target)
(substitute* target
+ (("@PACKAGE_NAME@") name)
(("@VERSION@") version))))
- (find-files modules
- (lambda (fn st)
- (string-suffix? ".in" fn))))
+ (append-map (lambda (dir) (find-files dir "\\.in$"))
+ modules))
(for-each (lambda (template)
(format #t "Configuring ~a~%" template)
(let ((target (string-drop-right template 3)))
@@ -70,7 +71,7 @@ and object directories."
(define (bootstrap-build modules)
"Create a procedure that builds an early bootstrap package. The
-procedure will search the MODULES directory and compile all of the
+procedure will search each directory in MODULES and compile all of the
'.scm' files."
(lambda _
(add-to-load-path (getcwd))
@@ -80,13 +81,15 @@ procedure will search the MODULES directory and compile all of the
(dir (dirname scm)))
(format #t "Compiling ~a~%" scm)
(compile-file scm #:output-file go)))
- (find-files modules "\\.scm$"))
+ (append-map (lambda (dir) (find-files dir "\\.scm$"))
+ modules))
#t))
(define (bootstrap-install modules scripts)
"Create a procedure that installs an early bootstrap package. The
-procedure will install all of the '.scm' and '.go' files in the MODULES
-directory, and all the executable files in the SCRIPTS directory."
+procedure will install all of the '.scm' and '.go' files in each of the
+directories in MODULES, and all the executable files in the SCRIPTS
+directory."
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(guile-dir (assoc-ref inputs "guile"))
@@ -104,7 +107,8 @@ directory, and all the executable files in the SCRIPTS directory."
(install-file scm (string-append moddir "/" dir))
(format #t "Installing ~a~%" go)
(install-file go (string-append godir "/" dir))))
- (find-files modules "\\.scm$"))
+ (append-map (lambda (dir) (find-files dir "\\.scm$"))
+ modules))
(for-each (lambda (script)
(format #t "Installing ~a~%" script)
(install-file script (string-append out "/bin")))
diff --git a/guix/build/minetest-build-system.scm b/guix/build/minetest-build-system.scm
index 5f68686067..4a7a87ab83 100644
--- a/guix/build/minetest-build-system.scm
+++ b/guix/build/minetest-build-system.scm
@@ -91,15 +91,6 @@ If it is unknown, make an educated guess."
#:install-plan (mod-install-plan (apply guess-mod-name arguments))
arguments))
-(define %png-magic-bytes
- ;; Magic bytes of PNG images, see ‘5.2 PNG signatures’ in
- ;; ‘Portable Network Graphics (PNG) Specification (Second Edition)’
- ;; on <https://www.w3.org/TR/PNG/>.
- #vu8(137 80 78 71 13 10 26 10))
-
-(define png-file?
- ((@@ (guix build utils) file-header-match) %png-magic-bytes))
-
(define* (minimise-png #:key inputs native-inputs #:allow-other-keys)
"Minimise PNG images found in the working directory."
(define optipng (which "optipng"))
diff --git a/guix/build/python-build-system.scm b/guix/build/python-build-system.scm
index 08871f60cd..aa04664b25 100644
--- a/guix/build/python-build-system.scm
+++ b/guix/build/python-build-system.scm
@@ -68,7 +68,7 @@
;; downloading the package source from PyPI (the Python Package Index). Both
;; of them import setuptools and execute the "setup.py" file under their
;; control. Thus the "setup.py" behaves as if the developer had imported
-;; setuptools within setup.py - even is still using only distutils.
+;; setuptools within setup.py - even if it is still using only distutils.
;;
;; Setuptools' "install" command (to be more precise: the "easy_install"
;; command which is called by "install") will put the path of the currently
@@ -176,8 +176,8 @@ without errors."
(define (site-packages inputs outputs)
"Return the path of the current output's Python site-package."
- (let* ((out (python-output outputs))
- (python (assoc-ref inputs "python")))
+ (let ((out (python-output outputs))
+ (python (assoc-ref inputs "python")))
(string-append out "/lib/python" (python-version python) "/site-packages")))
(define (add-installed-pythonpath inputs outputs)
diff --git a/guix/build/qt-utils.scm b/guix/build/qt-utils.scm
index 2e47f1bc02..b8ecfedd43 100644
--- a/guix/build/qt-utils.scm
+++ b/guix/build/qt-utils.scm
@@ -98,7 +98,7 @@
`("QTWEBENGINEPROCESS_PATH" = regular
,(format #f "/lib/qt~a/libexec/QtWebEngineProcess" qt-major-version)))))
-(define* (wrap-qt-program* program #:key inputs output-dir
+(define* (wrap-qt-program* program #:key sh inputs output-dir
qt-wrap-excluded-inputs
(qt-major-version %default-qt-major-version))
@@ -115,9 +115,9 @@
output-dir
#:qt-major-version qt-major-version)))
(when (not (null? vars-to-wrap))
- (apply wrap-program program vars-to-wrap))))
+ (apply wrap-program program #:sh sh vars-to-wrap))))
-(define* (wrap-qt-program program-name #:key inputs output
+(define* (wrap-qt-program program-name #:key (sh (which "bash")) inputs output
(qt-wrap-excluded-inputs %qt-wrap-excluded-inputs)
(qt-major-version %default-qt-major-version))
"Wrap the specified program (which must reside in the OUTPUT's \"/bin\"
@@ -126,11 +126,12 @@ directory) with suitably set environment variables.
This is like qt-build-systems's phase \"qt-wrap\", but only the named program
is wrapped."
(wrap-qt-program* (string-append output "/bin/" program-name)
+ #:sh sh
#:output-dir output #:inputs inputs
#:qt-wrap-excluded-inputs qt-wrap-excluded-inputs
#:qt-major-version qt-major-version))
-(define* (wrap-all-qt-programs #:key inputs outputs
+(define* (wrap-all-qt-programs #:key (sh (which "bash")) inputs outputs
qtbase
(qt-wrap-excluded-outputs '())
(qt-wrap-excluded-inputs %qt-wrap-excluded-inputs)
@@ -169,6 +170,7 @@ add a dependency of that output on Qt."
((output . output-dir)
(unless (member output qt-wrap-excluded-outputs)
(for-each (cut wrap-qt-program* <>
+ #:sh sh
#:output-dir output-dir #:inputs inputs
#:qt-wrap-excluded-inputs qt-wrap-excluded-inputs
#:qt-major-version qt-major-version)
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index dd5a91f52f..5ea3b98353 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -3,11 +3,11 @@
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2015, 2018, 2021 Mark H Weaver <mhw@netris.org>
-;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2018, 2022 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
-;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
;;;
;;; This file is part of GNU Guix.
@@ -60,8 +60,11 @@
directory-exists?
executable-file?
symbolic-link?
+ switch-symlinks
call-with-temporary-output-file
call-with-ascii-input-file
+ file-header-match
+ png-file?
elf-file?
ar-file?
gzip-file?
@@ -238,6 +241,25 @@ introduce the version part."
"Return #t if FILE is a symbolic link (aka. \"symlink\".)"
(eq? (stat:type (lstat file)) 'symlink))
+(define (switch-symlinks link target)
+ "Atomically switch LINK, a symbolic link, to point to TARGET. Works
+both when LINK already exists and when it does not."
+ (let ((pivot (string-append link ".new")))
+ ;; Create pivot link, deleting it if it already exists. This can
+ ;; happen if a previous switch-symlinks was interrupted.
+ (let symlink/remove-old ()
+ (catch 'system-error
+ (lambda ()
+ (symlink target pivot))
+ (lambda args
+ (if (= (system-error-errno args) EEXIST)
+ (begin
+ ;; Remove old link and retry.
+ (delete-file pivot)
+ (symlink/remove-old))
+ (apply throw args)))))
+ (rename-file pivot link)))
+
(define (call-with-temporary-output-file proc)
"Call PROC with a name of a temporary file and open output port to that
file; close the file and delete it when leaving the dynamic extent of this
@@ -291,6 +313,15 @@ with the bytes in HEADER, a bytevector."
#f ;FILE is a directory
(apply throw args))))))
+(define %png-magic-bytes
+ ;; Magic bytes of PNG images, see ‘5.2 PNG signatures’ in
+ ;; ‘Portable Network Graphics (PNG) Specification (Second Edition)’
+ ;; on <https://www.w3.org/TR/PNG/>.
+ #vu8(137 80 78 71 13 10 26 10))
+
+(define png-file?
+ (file-header-match %png-magic-bytes))
+
(define %elf-magic-bytes
;; Magic bytes of ELF files. See <elf.h>.
(u8-list->bytevector (map char->integer (string->list "\x7FELF"))))
diff --git a/guix/lint.scm b/guix/lint.scm
index edba1c2663..7d6fd5ee7e 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -585,7 +585,6 @@ or \"bash-minimal\" is not in its inputs. 'wrap-script' is not supported."
(('wrap-program _ . _)
(list (report-wrap-program-error package 'wrap-program)))
;; Wrapper of 'wrap-program' for Qt programs.
- ;; TODO #:sh is not yet supported but probably will be.
(('wrap-qt-program _ '#:sh . _) '())
(('wrap-qt-program _ . _)
(list (report-wrap-program-error package 'wrap-qt-program)))
diff --git a/guix/profiles.scm b/guix/profiles.scm
index d1dfa13e98..6aaaa4f6c0 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -12,6 +12,7 @@
;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2014 David Thompson <davet@gnu.org>
+;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -32,7 +33,7 @@
#:use-module ((guix config) #:select (%state-directory))
#:use-module ((guix utils) #:hide (package-name->name+version))
#:use-module ((guix build utils)
- #:select (package-name->name+version mkdir-p))
+ #:select (package-name->name+version mkdir-p switch-symlinks))
#:use-module ((guix diagnostics) #:select (&fix-hint formatted-message))
#:use-module (guix i18n)
#:use-module (guix records)
diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm
index 4add7e7c69..ae830d0b48 100644
--- a/guix/scripts/home.scm
+++ b/guix/scripts/home.scm
@@ -4,6 +4,7 @@
;;; Copyright © 2021 Pierre Langlois <pierre.langlois@gmx.com>
;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2022 Antero Mejr <antero@mailbox.org>
;;;
;;; This file is part of GNU Guix.
@@ -64,7 +65,7 @@
#:autoload (guix scripts home edit) (guix-home-edit)
#:autoload (guix scripts home import) (import-manifest)
#:use-module ((guix status) #:select (with-status-verbosity))
- #:use-module ((guix build utils) #:select (mkdir-p))
+ #:use-module ((guix build utils) #:select (mkdir-p switch-symlinks))
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (srfi srfi-1)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 7d92598efa..404925cb5a 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -11,6 +11,7 @@
;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2018 Steve Sprang <scs@stevesprang.com>
;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
+;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2022 Antero Mejr <antero@mailbox.org>
;;;
;;; This file is part of GNU Guix.
@@ -50,7 +51,7 @@
#:autoload (guix channels) (channel-name channel-commit channel->code)
#:autoload (guix store roots) (gc-roots user-owned?)
#:use-module ((guix build utils)
- #:select (directory-exists? mkdir-p))
+ #:select (directory-exists? mkdir-p switch-symlinks))
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:autoload (ice-9 pretty-print) (pretty-print)
diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index 9ca66687ee..a173e011b4 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -6,6 +6,7 @@
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
+;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -94,7 +95,8 @@ atomically, and run OS's activation script."
#:select? not-config?)
((guix config) => ,(make-config.scm)))
#~(begin
- (use-modules (guix config)
+ (use-modules (guix build utils)
+ (guix config)
(guix profiles)
(guix utils))
diff --git a/guix/utils.scm b/guix/utils.scm
index aca0af4e4b..1a1cf673b8 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -126,7 +126,6 @@
file-sans-extension
tarball-sans-extension
compressed-file?
- switch-symlinks
call-with-temporary-directory
with-atomic-file-output
@@ -913,13 +912,6 @@ VERSIONS. For example:
(->bool (member (file-extension file)
'("gz" "bz2" "xz" "lz" "lzma" "tgz" "tbz2" "zip"))))
-(define (switch-symlinks link target)
- "Atomically switch LINK, a symbolic link, to point to TARGET. Works
-both when LINK already exists and when it does not."
- (let ((pivot (string-append link ".new")))
- (symlink target pivot)
- (rename-file pivot link)))
-
(define* (string-replace-substring str substr replacement
#:optional
(start 0)
generated by cgit v1.2.3 (git 2.46.2) at 2024-11-13 00:49:18 +0000