From efe3c5717dbb613dae9c99c2618ba326de50677c Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sun, 9 Sep 2018 11:43:23 +0200 Subject: guix: copy-linux-headers: Extract procedure, add headers. * guix/build/make-bootstrap.scm (copy-linux-headers): New procedure; extract from make-stripped-libc and add headers for Mes bootstrap. (make-stripped-libc): Use it. --- guix/build/make-bootstrap.scm | 72 +++++++++++++++++++++++++++++++------------ 1 file changed, 53 insertions(+), 19 deletions(-) (limited to 'guix/build') diff --git a/guix/build/make-bootstrap.scm b/guix/build/make-bootstrap.scm index 43b136248f..0c7b4ac6fd 100644 --- a/guix/build/make-bootstrap.scm +++ b/guix/build/make-bootstrap.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015, 2017 Manolis Fragkiskos Ragkousis ;;; Copyright © 2015 Ludovic Courtès +;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,7 +24,8 @@ #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:use-module (guix build utils) - #:export (make-stripped-libc)) + #:export (copy-linux-headers + make-stripped-libc)) ;; Commentary: ;; @@ -31,6 +33,53 @@ ;; ;; Code: +(define (copy-linux-headers output kernel-headers) + "Copy to OUTPUT the subset of KERNEL-HEADERS that is needed when producing a +bootstrap libc." + + (let* ((incdir (string-append output "/include"))) + (mkdir-p incdir) + + ;; Copy some of the Linux-Libre headers that glibc headers + ;; refer to. + (mkdir (string-append incdir "/linux")) + (for-each (lambda (file) + (install-file (pk 'src (string-append kernel-headers "/include/linux/" file)) + (pk 'dest (string-append incdir "/linux")))) + '( + "a.out.h" ; for 2.2.5 + "atalk.h" ; for 2.2.5 + "errno.h" + "falloc.h" + "if_addr.h" ; for 2.16.0 + "if_ether.h" ; for 2.2.5 + "if_link.h" ; for 2.16.0 + "ioctl.h" + "kernel.h" + "limits.h" + "neighbour.h" ; for 2.16.0 + "netlink.h" ; for 2.16.0 + "param.h" + "prctl.h" ; for 2.16.0 + "posix_types.h" + "rtnetlink.h" ; for 2.16.0 + "socket.h" + "stddef.h" + "swab.h" ; for 2.2.5 + "sysctl.h" + "sysinfo.h" ; for 2.2.5 + "types.h" + "version.h" ; for 2.2.5 + )) + + (copy-recursively (string-append kernel-headers "/include/asm") + (string-append incdir "/asm")) + (copy-recursively (string-append kernel-headers "/include/asm-generic") + (string-append incdir "/asm-generic")) + (copy-recursively (string-append kernel-headers "/include/linux/byteorder") + (string-append incdir "/linux/byteorder")) + #t)) + (define (make-stripped-libc output libc kernel-headers) "Copy to OUTPUT the subset of LIBC and KERNEL-HEADERS that is needed when producing a bootstrap libc." @@ -43,25 +92,10 @@ when producing a bootstrap libc." (string-append incdir "/mach")) #t)) - (define (copy-linux-headers output kernel-headers) + (define (copy-libc+linux-headers output kernel-headers) (let* ((incdir (string-append output "/include"))) (copy-recursively (string-append libc "/include") incdir) - - ;; Copy some of the Linux-Libre headers that glibc headers - ;; refer to. - (mkdir (string-append incdir "/linux")) - (for-each (lambda (file) - (install-file (string-append kernel-headers "/include/linux/" file) - (string-append incdir "/linux"))) - '("limits.h" "errno.h" "socket.h" "kernel.h" - "sysctl.h" "param.h" "ioctl.h" "types.h" - "posix_types.h" "stddef.h" "falloc.h")) - - (copy-recursively (string-append kernel-headers "/include/asm") - (string-append incdir "/asm")) - (copy-recursively (string-append kernel-headers "/include/asm-generic") - (string-append incdir "/asm-generic")) - #t)) + (copy-linux-headers output kernel-headers))) (define %libc-object-files-rx "^(crt.*|ld.*|lib(c|m|dl|rt|pthread|nsl|\ util).*\\.so(\\..*)?|lib(machuser|hurduser).so.*|(libc(rt|)|libpthread)\ @@ -80,6 +114,6 @@ _nonshared\\.a)$") (if (directory-exists? (string-append kernel-headers "/include/mach")) (copy-mach-headers output kernel-headers) - (copy-linux-headers output kernel-headers))) + (copy-libc+linux-headers output kernel-headers))) -- cgit v1.2.3 From 89e7f90d0b40bc4f15f902cc3b82c3effa87dd02 Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Wed, 11 Jul 2018 13:03:33 +0530 Subject: build-system: python: Do not double wrap executables. * guix/build/python-build-system.scm (wrap): Only wrap executables that have not already been wrapped. * guix/build/utils.scm (wrapper?): New function. --- guix/build/python-build-system.scm | 9 ++++----- guix/build/utils.scm | 9 +++++++++ 2 files changed, 13 insertions(+), 5 deletions(-) (limited to 'guix/build') diff --git a/guix/build/python-build-system.scm b/guix/build/python-build-system.scm index 5bb0ba49d5..73b554c766 100644 --- a/guix/build/python-build-system.scm +++ b/guix/build/python-build-system.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2015, 2018 Mark H Weaver ;;; Copyright © 2016 Hartmut Goebel ;;; Copyright © 2018 Ricardo Wurmus +;;; Copyright © 2018 Arun Isaac ;;; ;;; This file is part of GNU Guix. ;;; @@ -186,11 +187,9 @@ when running checks after installing the package." (define* (wrap #:key inputs outputs #:allow-other-keys) (define (list-of-files dir) - (map (cut string-append dir "/" <>) - (or (scandir dir (lambda (f) - (let ((s (stat (string-append dir "/" f)))) - (eq? 'regular (stat:type s))))) - '()))) + (find-files dir (lambda (file stat) + (and (eq? 'regular (stat:type stat)) + (not (wrapper? file)))))) (define bindirs (append-map (match-lambda diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 5fe3286843..cb5621a5a9 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2013 Andreas Enge ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2015, 2018 Mark H Weaver +;;; Copyright © 2018 Arun Isaac ;;; ;;; This file is part of GNU Guix. ;;; @@ -87,6 +88,7 @@ patch-/usr/bin/file fold-port-matches remove-store-references + wrapper? wrap-program invoke @@ -1003,6 +1005,13 @@ known as `nuke-refs' in Nixpkgs." (put-u8 out (char->integer char)) result)))))) +(define (wrapper? prog) + "Return #t if PROG is a wrapper as produced by 'wrap-program'." + (and (file-exists? prog) + (let ((base (basename prog))) + (and (string-prefix? "." base) + (string-suffix? "-real" base))))) + (define* (wrap-program prog #:rest vars) "Make a wrapper for PROG. VARS should look like this: -- cgit v1.2.3 From 782f1ea9f693639b8feb3152fa6a280356ab1167 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 29 Jan 2019 09:49:33 +0100 Subject: utils: Switch to the new 'setvbuf' API. * guix/build/utils.scm (setvbuf) [(and guile-2 (not guile-2.2))]: New procedure. (remove-store-references): Use the 2.2 'setvbuf' API style. * guix/build/gnu-build-system.scm (gnu-build): Likewise. --- guix/build/gnu-build-system.scm | 6 +++--- guix/build/utils.scm | 26 +++++++++++++++++++++++--- 2 files changed, 26 insertions(+), 6 deletions(-) (limited to 'guix/build') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index e5f3197b0a..7d92b8d72e 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2018 Mark H Weaver ;;; ;;; This file is part of GNU Guix. @@ -784,8 +784,8 @@ in order. Return #t if all the PHASES succeeded, #f otherwise." (+ (time-second diff) (/ (time-nanosecond diff) 1e9)))) - (setvbuf (current-output-port) _IOLBF) - (setvbuf (current-error-port) _IOLBF) + (setvbuf (current-output-port) 'line) + (setvbuf (current-error-port) 'line) ;; Encoding/decoding errors shouldn't be silent. (fluid-set! %default-port-conversion-strategy 'error) diff --git a/guix/build/utils.scm b/guix/build/utils.scm index cb5621a5a9..a21dbb0128 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2013 Andreas Enge ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2015, 2018 Mark H Weaver @@ -101,7 +101,27 @@ locale-category->string)) + +;;; +;;; Guile 2.0 compatibility later. +;;; +;; The bootstrap Guile is Guile 2.0, so provide a compatibility layer. +(cond-expand + ((and guile-2 (not guile-2.2)) + (define (setvbuf port mode . rest) + (apply (@ (guile) setvbuf) port + (match mode + ('line _IOLBF) + ('block _IOFBF) + ('none _IONBF) + (_ mode)) ;an _IO* integer + rest)) + + (module-replace! (current-module) '(setvbuf))) + (else #f)) + + ;;; ;;; Directories. ;;; @@ -989,8 +1009,8 @@ known as `nuke-refs' in Nixpkgs." ;; We cannot use `regexp-exec' here because it cannot deal with ;; strings containing NUL characters. (format #t "removing store references from `~a'...~%" file) - (setvbuf in _IOFBF 65536) - (setvbuf out _IOFBF 65536) + (setvbuf in 'block 65536) + (setvbuf out 'block 65536) (fold-port-matches (lambda (match result) (put-bytevector out (string->utf8 store)) (put-u8 out (char->integer #\/)) -- cgit v1.2.3 From f380f9d55e6757c242acf6c71c4a3ccfcdb066b2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 29 Jan 2019 11:00:42 +0100 Subject: build-system/gnu: Report invocation errors in a human-friendly way. * guix/build/utils.scm (report-invoke-error): New procedure. * guix/build/gnu-build-system.scm (gnu-build): Guard against 'invoke-error?'. --- guix/build/gnu-build-system.scm | 43 ++++++++++++++++++++++------------------- guix/build/utils.scm | 17 ++++++++++++++++ 2 files changed, 40 insertions(+), 20 deletions(-) (limited to 'guix/build') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 7d92b8d72e..3f68ad52ed 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -790,28 +790,31 @@ in order. Return #t if all the PHASES succeeded, #f otherwise." ;; Encoding/decoding errors shouldn't be silent. (fluid-set! %default-port-conversion-strategy 'error) - ;; The trick is to #:allow-other-keys everywhere, so that each procedure in - ;; PHASES can pick the keyword arguments it's interested in. - (every (match-lambda - ((name . proc) - (let ((start (current-time time-monotonic))) - (format #t "starting phase `~a'~%" name) - (let ((result (apply proc args)) - (end (current-time time-monotonic))) - (format #t "phase `~a' ~:[failed~;succeeded~] after ~,1f seconds~%" - name result - (elapsed-time end start)) - - ;; Issue a warning unless the result is #t. - (unless (eqv? result #t) - (format (current-error-port) "\ + (guard (c ((invoke-error? c) + (report-invoke-error c) + (exit 1))) + ;; The trick is to #:allow-other-keys everywhere, so that each procedure in + ;; PHASES can pick the keyword arguments it's interested in. + (every (match-lambda + ((name . proc) + (let ((start (current-time time-monotonic))) + (format #t "starting phase `~a'~%" name) + (let ((result (apply proc args)) + (end (current-time time-monotonic))) + (format #t "phase `~a' ~:[failed~;succeeded~] after ~,1f seconds~%" + name result + (elapsed-time end start)) + + ;; Issue a warning unless the result is #t. + (unless (eqv? result #t) + (format (current-error-port) "\ ## WARNING: phase `~a' returned `~s'. Return values other than #t ## are deprecated. Please migrate this package so that its phase ## procedures report errors by raising an exception, and otherwise ## always return #t.~%" - name result)) + name result)) - ;; Dump the environment variables as a shell script, for handy debugging. - (system "export > $NIX_BUILD_TOP/environment-variables") - result)))) - phases)) + ;; Dump the environment variables as a shell script, for handy debugging. + (system "export > $NIX_BUILD_TOP/environment-variables") + result)))) + phases))) diff --git a/guix/build/utils.scm b/guix/build/utils.scm index a21dbb0128..55d34b67e7 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -98,6 +98,7 @@ invoke-error-exit-status invoke-error-term-signal invoke-error-stop-signal + report-invoke-error locale-category->string)) @@ -622,6 +623,11 @@ Where every <*-phase-name> is an expression evaluating to a symbol, and ((_ phases (add-after old-phase-name new-phase-name new-phase)) (alist-cons-after old-phase-name new-phase-name new-phase phases)))) + +;;; +;;; Program invocation. +;;; + (define-condition-type &invoke-error &error invoke-error? (program invoke-error-program) @@ -643,6 +649,17 @@ if the exit code is non-zero; otherwise return #t." (stop-signal (status:stop-sig code)))))) #t)) +(define* (report-invoke-error c #:optional (port (current-error-port))) + "Report to PORT about C, an '&invoke-error' condition, in a human-friendly +way." + (format port "command~{ ~s~} failed with ~:[signal~;status~] ~a~%" + (cons (invoke-error-program c) + (invoke-error-arguments c)) + (invoke-error-exit-status c) + (or (invoke-error-exit-status c) + (invoke-error-term-signal c) + (invoke-error-stop-signal c)))) + ;;; ;;; Text substitution (aka. sed). -- cgit v1.2.3 From 0fb9a8df429a7b9f40610ff15baaff0d8e31e8cf Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Tue, 2 Jan 2018 21:43:07 +0100 Subject: guix: Add wrap-script. * guix/build/utils.scm (wrap-script): New procedure. (&wrap-error): New condition. (wrap-error?, wrap-error-program, wrap-error-type): New procedures. * tests/build-utils.scm ("wrap-script, simple case", "wrap-script, with encoding declaration", "wrap-script, raises condition"): New tests. --- guix/build/utils.scm | 125 ++++++++++++++++++++++++++++++++++++++++++++++++++ tests/build-utils.scm | 102 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 227 insertions(+) (limited to 'guix/build') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 55d34b67e7..b7cd748d81 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2015, 2018 Mark H Weaver ;;; Copyright © 2018 Arun Isaac +;;; Copyright © 2018, 2019 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; @@ -90,6 +91,11 @@ remove-store-references wrapper? wrap-program + wrap-script + + wrap-error? + wrap-error-program + wrap-error-type invoke invoke-error? @@ -1042,6 +1048,11 @@ known as `nuke-refs' in Nixpkgs." (put-u8 out (char->integer char)) result)))))) +(define-condition-type &wrap-error &error + wrap-error? + (program wrap-error-program) + (type wrap-error-type)) + (define (wrapper? prog) "Return #t if PROG is a wrapper as produced by 'wrap-program'." (and (file-exists? prog) @@ -1146,6 +1157,120 @@ with definitions for VARS." (chmod prog-tmp #o755) (rename-file prog-tmp prog)))) +(define wrap-script + (let ((interpreter-regex + (make-regexp + (string-append "^#! ?(/[^ ]+/bin/(" + (string-join '("python[^ ]*" + "Rscript" + "perl" + "ruby" + "bash" + "sh") "|") + "))( ?.*)"))) + (coding-line-regex + (make-regexp + ".*#.*coding[=:][[:space:]]*([-a-zA-Z_0-9.]+)"))) + (lambda* (prog #:key (guile (which "guile")) #:rest vars) + "Wrap the script PROG such that VARS are set first. The format of VARS +is the same as in the WRAP-PROGRAM procedure. This procedure differs from +WRAP-PROGRAM in that it does not create a separate shell script. Instead, +PROG is modified directly by prepending a Guile script, which is interpreted +as a comment in the script's language. + +Special encoding comments as supported by Python are recreated on the second +line. + +Note that this procedure can only be used once per file as Guile scripts are +not supported." + (define update-env + (match-lambda + ((var sep '= rest) + `(setenv ,var ,(string-join rest sep))) + ((var sep 'prefix rest) + `(let ((current (getenv ,var))) + (setenv ,var (if current + (string-append ,(string-join rest sep) + ,sep current) + ,(string-join rest sep))))) + ((var sep 'suffix rest) + `(let ((current (getenv ,var))) + (setenv ,var (if current + (string-append current ,sep + ,(string-join rest sep)) + ,(string-join rest sep))))) + ((var '= rest) + `(setenv ,var ,(string-join rest ":"))) + ((var 'prefix rest) + `(let ((current (getenv ,var))) + (setenv ,var (if current + (string-append ,(string-join rest ":") + ":" current) + ,(string-join rest ":"))))) + ((var 'suffix rest) + `(let ((current (getenv ,var))) + (setenv ,var (if current + (string-append current ":" + ,(string-join rest ":")) + ,(string-join rest ":"))))))) + (let-values (((interpreter args coding-line) + (call-with-ascii-input-file prog + (lambda (p) + (let ((first-match + (false-if-exception + (regexp-exec interpreter-regex (read-line p))))) + (values (and first-match (match:substring first-match 1)) + (and first-match (match:substring first-match 3)) + (false-if-exception + (and=> (regexp-exec coding-line-regex (read-line p)) + (lambda (m) (match:substring m 0)))))))))) + (if interpreter + (let* ((header (format #f "\ +#!~a --no-auto-compile +#!#; ~a +#\\-~s +#\\-~s +" + guile + (or coding-line "Guix wrapper") + (cons 'begin (map update-env + (match vars + ((#:guile _ . vars) vars) + (_ vars)))) + `(let ((cl (command-line))) + (apply execl ,interpreter + (car cl) + (cons (car cl) + (append + ',(string-split args #\space) + cl)))))) + (template (string-append prog ".XXXXXX")) + (out (mkstemp! template)) + (st (stat prog)) + (mode (stat:mode st))) + (with-throw-handler #t + (lambda () + (call-with-ascii-input-file prog + (lambda (p) + (format out header) + (dump-port p out) + (close out) + (chmod template mode) + (rename-file template prog) + (set-file-time prog st)))) + (lambda (key . args) + (format (current-error-port) + "wrap-script: ~a: error: ~a ~s~%" + prog key args) + (false-if-exception (delete-file template)) + (raise (condition + (&wrap-error (program prog) + (type key)))) + #f))) + (raise (condition + (&wrap-error (program prog) + (type 'no-interpreter-found))))))))) + ;;; ;;; Locales. diff --git a/tests/build-utils.scm b/tests/build-utils.scm index 7d49446f66..1c9084514d 100644 --- a/tests/build-utils.scm +++ b/tests/build-utils.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2015, 2016 Ludovic Courtès +;;; Copyright © 2019 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; @@ -122,4 +123,105 @@ (and (zero? (close-pipe pipe)) str)))))) +(let ((script-contents "\ +#!/anything/cabbage-bash-1.2.3/bin/sh + +echo hello world")) + + (test-equal "wrap-script, simple case" + (string-append + (format #f "\ +#!GUILE --no-auto-compile +#!#; Guix wrapper +#\\-~s +#\\-~s +" + '(begin (let ((current (getenv "GUIX_FOO"))) + (setenv "GUIX_FOO" + (if current + (string-append "/some/path:/some/other/path" + ":" current) + "/some/path:/some/other/path")))) + '(let ((cl (command-line))) + (apply execl "/anything/cabbage-bash-1.2.3/bin/sh" + (car cl) + (cons (car cl) + (append '("") cl))))) + script-contents) + (call-with-temporary-directory + (lambda (directory) + (let ((script-file-name (string-append directory "/foo"))) + (call-with-output-file script-file-name + (lambda (port) + (format port script-contents))) + (chmod script-file-name #o777) + + (mock ((guix build utils) which (const "GUILE")) + (wrap-script script-file-name + `("GUIX_FOO" prefix ("/some/path" + "/some/other/path")))) + (let ((str (call-with-input-file script-file-name get-string-all))) + (with-directory-excursion directory + (delete-file "foo")) + str)))))) + +(let ((script-contents "\ +#!/anything/cabbage-bash-1.2.3/bin/python3 -and -args +# vim:fileencoding=utf-8 +print('hello world')")) + + (test-equal "wrap-script, with encoding declaration" + (string-append + (format #f "\ +#!MYGUILE --no-auto-compile +#!#; # vim:fileencoding=utf-8 +#\\-~s +#\\-~s +" + '(begin (let ((current (getenv "GUIX_FOO"))) + (setenv "GUIX_FOO" + (if current + (string-append "/some/path:/some/other/path" + ":" current) + "/some/path:/some/other/path")))) + `(let ((cl (command-line))) + (apply execl "/anything/cabbage-bash-1.2.3/bin/python3" + (car cl) + (cons (car cl) + (append '("" "-and" "-args") cl))))) + script-contents) + (call-with-temporary-directory + (lambda (directory) + (let ((script-file-name (string-append directory "/foo"))) + (call-with-output-file script-file-name + (lambda (port) + (format port script-contents))) + (chmod script-file-name #o777) + + (wrap-script script-file-name + #:guile "MYGUILE" + `("GUIX_FOO" prefix ("/some/path" + "/some/other/path"))) + (let ((str (call-with-input-file script-file-name get-string-all))) + (with-directory-excursion directory + (delete-file "foo")) + str)))))) + +(test-assert "wrap-script, raises condition" + (call-with-temporary-directory + (lambda (directory) + (let ((script-file-name (string-append directory "/foo"))) + (call-with-output-file script-file-name + (lambda (port) + (format port "This is not a script"))) + (chmod script-file-name #o777) + (catch 'srfi-34 + (lambda () + (wrap-script script-file-name + #:guile "MYGUILE" + `("GUIX_FOO" prefix ("/some/path" + "/some/other/path")))) + (lambda (type obj) + (wrap-error? obj))))))) + (test-end) -- cgit v1.2.3 From 278409e7e9ad63b80afa0a40c220dedd78c0aa54 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 9 Mar 2019 15:08:11 +0100 Subject: build-system/gnu: Always look for license files in the source tree. Fixes . * guix/build/gnu-build-system.scm (install-license-files): Add #:out-of-source?. [find-source-directory]: New procedure. Use it to Determine the source directory and look for license files there. --- guix/build/gnu-build-system.scm | 48 ++++++++++++++++++++++++++++++++++------- 1 file changed, 40 insertions(+), 8 deletions(-) (limited to 'guix/build') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 3f68ad52ed..f62e96112d 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -735,8 +735,29 @@ which cannot be found~%" (define* (install-license-files #:key outputs (license-file-regexp %license-file-regexp) + out-of-source? #:allow-other-keys) "Install license files matching LICENSE-FILE-REGEXP to 'share/doc'." + (define (find-source-directory package) + ;; For an out-of-source build, guess the source directory location + ;; relative to the current directory. Return #f on failure. + (match (scandir ".." + (lambda (file) + (and (not (member file '("." ".." "build"))) + (file-is-directory? + (string-append "../" file))))) + (() ;hmm, no source + #f) + ((source) ;only one other file + (string-append "../" source)) + ((directories ...) ;pick the most likely one + ;; This happens for example with libstdc++, which lives within the GCC + ;; source tree. + (any (lambda (directory) + (and (string-prefix? package directory) + (string-append "../" directory))) + directories)))) + (let* ((regexp (make-regexp license-file-regexp)) (out (or (assoc-ref outputs "out") (match outputs @@ -744,14 +765,25 @@ which cannot be found~%" output)))) (package (strip-store-file-name out)) (directory (string-append out "/share/doc/" package)) - (files (scandir "." (lambda (file) - (regexp-exec regexp file))))) - (format #t "installing ~a license files~%" (length files)) - (for-each (lambda (file) - (if (file-is-directory? file) - (copy-recursively file directory) - (install-file file directory))) - files) + (source (if out-of-source? + (find-source-directory + (package-name->name+version package)) + ".")) + (files (and source + (scandir source + (lambda (file) + (regexp-exec regexp file)))))) + (if files + (begin + (format #t "installing ~a license files from '~a'~%" + (length files) source) + (for-each (lambda (file) + (if (file-is-directory? file) + (copy-recursively file directory) + (install-file file directory))) + (map (cut string-append source "/" <>) files))) + (format (current-error-port) + "failed to find license files~%")) #t)) (define %standard-phases -- cgit v1.2.3 From 6db044db45495aae471e1e8f537e267a0cb25cf5 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 10 Mar 2019 22:16:14 +0100 Subject: build-system/gnu: Copy license files to all the outputs. Fixes . Reported by Leo Famulari . * guix/build/gnu-build-system.scm (install-license-files)[copy-to-directories]: New procedure. Call it to copy license files to all the outputs. --- guix/build/gnu-build-system.scm | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) (limited to 'guix/build') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index f62e96112d..afa1886ecd 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -758,13 +758,23 @@ which cannot be found~%" (string-append "../" directory))) directories)))) + (define (copy-to-directories directories sub-directory) + (lambda (file) + (for-each (if (file-is-directory? file) + (cut copy-recursively file <>) + (cut install-file file <>)) + (map (cut string-append <> "/" sub-directory) + directories)))) + (let* ((regexp (make-regexp license-file-regexp)) (out (or (assoc-ref outputs "out") (match outputs (((_ . output) _ ...) output)))) (package (strip-store-file-name out)) - (directory (string-append out "/share/doc/" package)) + (outputs (match outputs + (((_ . outputs) ...) + outputs))) (source (if out-of-source? (find-source-directory (package-name->name+version package)) @@ -777,10 +787,9 @@ which cannot be found~%" (begin (format #t "installing ~a license files from '~a'~%" (length files) source) - (for-each (lambda (file) - (if (file-is-directory? file) - (copy-recursively file directory) - (install-file file directory))) + (for-each (copy-to-directories outputs + (string-append "share/doc/" + package)) (map (cut string-append source "/" <>) files))) (format (current-error-port) "failed to find license files~%")) -- cgit v1.2.3 From 6bbb37a545912c6bb2513ee08587ee4fe39cc330 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Wed, 3 Apr 2019 00:09:20 -0400 Subject: build-system/python: Move the check phase after the install phase. A reproducibility problem was discovered while packaging python-pygithub where the bytecode produced by running the tests would interfere with the result of the install phase byte compilation. Moving the check phase after the install phase solves the problem. * guix/build/python-build-system.scm (%standard-phases): Add comment, move the check phase after the install phase. --- guix/build/python-build-system.scm | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) (limited to 'guix/build') diff --git a/guix/build/python-build-system.scm b/guix/build/python-build-system.scm index 73b554c766..7c00306b3e 100644 --- a/guix/build/python-build-system.scm +++ b/guix/build/python-build-system.scm @@ -250,16 +250,21 @@ installed with setuptools." #t) (define %standard-phases - ;; 'configure' phase is not needed. + ;; The build phase only builds C extensions and copies the Python sources, + ;; while the install phase byte-compiles and copies them to the prefix + ;; directory. The tests are run after the install phase because otherwise + ;; the cached .pyc generated during the tests execution seem to interfere + ;; with the byte compilation of the install phase. (modify-phases gnu:%standard-phases (add-after 'unpack 'ensure-no-mtimes-pre-1980 ensure-no-mtimes-pre-1980) (add-after 'ensure-no-mtimes-pre-1980 'enable-bytecode-determinism enable-bytecode-determinism) (delete 'bootstrap) - (delete 'configure) - (replace 'install install) - (replace 'check check) + (delete 'configure) ;not needed (replace 'build build) + (delete 'check) ;moved after the install phase + (replace 'install install) + (add-after 'install 'check check) (add-after 'install 'wrap wrap) (add-before 'strip 'rename-pth-file rename-pth-file))) -- cgit v1.2.3 From cfd4e4d06e3cda0f3eed8d6b9277ce53e55404b8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 14 Jun 2019 23:02:28 +0200 Subject: build-system/gnu: Make 'first-subdirectory' deterministic. Fixes . Reported by Christopher Baines . * guix/build/gnu-build-system.scm (first-subdirectory): Rewrite using 'scandir' so that the result is deterministic. --- guix/build/gnu-build-system.scm | 22 +++++++++------------- 1 file changed, 9 insertions(+), 13 deletions(-) (limited to 'guix/build') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index afa1886ecd..4df0bb4904 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -25,6 +25,7 @@ #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (ice-9 format) + #:use-module (ice-9 ftw) #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) #:use-module (srfi srfi-34) @@ -58,19 +59,14 @@ See https://reproducible-builds.org/specs/source-date-epoch/." (setenv "SOURCE_DATE_EPOCH" "1") #t) -(define (first-subdirectory dir) - "Return the path of the first sub-directory of DIR." - (file-system-fold (lambda (path stat result) - (string=? path dir)) - (lambda (path stat result) result) ; leaf - (lambda (path stat result) result) ; down - (lambda (path stat result) result) ; up - (lambda (path stat result) ; skip - (or result path)) - (lambda (path stat errno result) ; error - (error "first-subdirectory" (strerror errno))) - #f - dir)) +(define (first-subdirectory directory) + "Return the file name of the first sub-directory of DIRECTORY." + (match (scandir directory + (lambda (file) + (and (not (member file '("." ".."))) + (file-is-directory? (string-append directory "/" + file))))) + ((first . _) first))) (define* (set-paths #:key target inputs native-inputs (search-paths '()) (native-search-paths '()) -- cgit v1.2.3 From 45d46223f92b0933aaf9b1392a21d09eaa1e2881 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 17 Jun 2019 16:06:27 +0200 Subject: utils: Add 'invoke/quiet'. * gnu/build/bootloader.scm (G_): Remove. (open-pipe-with-stderr, invoke/quiet): Move to... * guix/build/utils.scm: ... here. Use 'let-values' instead of 'define-values' because Guile 2.0 (the bootstrap Guile) doesn't know about 'define-values'. * po/guix/POTFILES.in: Remove gnu/build/bootloader.scm, and add guix/build/utils.scm. * tests/build-utils.scm: Remove import of (gnu build bootloader). --- gnu/build/bootloader.scm | 62 +----------------------------------------------- guix/build/utils.scm | 53 +++++++++++++++++++++++++++++++++++++++++ po/guix/POTFILES.in | 3 +-- tests/build-utils.scm | 2 -- 4 files changed, 55 insertions(+), 65 deletions(-) (limited to 'guix/build') diff --git a/gnu/build/bootloader.scm b/gnu/build/bootloader.scm index c5febcde1e..9570d6dd18 100644 --- a/gnu/build/bootloader.scm +++ b/gnu/build/bootloader.scm @@ -18,15 +18,8 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu build bootloader) - #:use-module (srfi srfi-34) - #:use-module (srfi srfi-35) #:use-module (ice-9 binary-ports) - #:use-module (ice-9 popen) - #:use-module (ice-9 match) - #:use-module (ice-9 rdelim) - #:use-module (ice-9 format) - #:export (write-file-on-device - invoke/quiet)) + #:export (write-file-on-device)) ;;; @@ -43,56 +36,3 @@ (seek output offset SEEK_SET) (put-bytevector output bv)) #:binary #t))))) - -(define-syntax-rule (G_ str) str) ;for xgettext - -(define (open-pipe-with-stderr program . args) - "Run PROGRAM with ARGS in an input pipe, but, unlike 'open-pipe*', redirect -both its standard output and standard error to the pipe. Return two value: -the pipe to read PROGRAM's data from, and the PID of the child process running -PROGRAM." - ;; 'open-pipe*' doesn't attempt to capture stderr in any way, which is why - ;; we need to roll our own. - (match (pipe) - ((input . output) - (match (primitive-fork) - (0 - (dynamic-wind - (const #t) - (lambda () - (close-port input) - (dup2 (fileno output) 1) - (dup2 (fileno output) 2) - (apply execlp program program args)) - (lambda () - (primitive-exit 127)))) - (pid - (close-port output) - (values input pid)))))) - -;; TODO: Move to (guix build utils) on the next rebuild cycle. -(define (invoke/quiet program . args) - "Invoke PROGRAM with ARGS and capture PROGRAM's standard output and standard -error. If PROGRAM succeeds, print nothing and return the unspecified value; -otherwise, raise a '&message' error condition that includes the status code -and the output of PROGRAM." - (define-values (pipe pid) - (apply open-pipe-with-stderr program args)) - - (let loop ((lines '())) - (match (read-line pipe) - ((? eof-object?) - (close-port pipe) - (match (waitpid pid) - ((_ . status) - (unless (zero? status) - (raise (condition - (&message - (message (format #f (G_ "'~a~{ ~a~}' exited with status ~a; \ -output follows:~%~%~{ ~a~%~}") - program args - (or (status:exit-val status) - status) - (reverse lines)))))))))) - (line - (loop (cons line lines)))))) diff --git a/guix/build/utils.scm b/guix/build/utils.scm index b7cd748d81..b8be73ead4 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -106,6 +106,8 @@ invoke-error-stop-signal report-invoke-error + invoke/quiet + locale-category->string)) @@ -666,6 +668,57 @@ way." (invoke-error-term-signal c) (invoke-error-stop-signal c)))) +(define (open-pipe-with-stderr program . args) + "Run PROGRAM with ARGS in an input pipe, but, unlike 'open-pipe*', redirect +both its standard output and standard error to the pipe. Return two value: +the pipe to read PROGRAM's data from, and the PID of the child process running +PROGRAM." + ;; 'open-pipe*' doesn't attempt to capture stderr in any way, which is why + ;; we need to roll our own. + (match (pipe) + ((input . output) + (match (primitive-fork) + (0 + (dynamic-wind + (const #t) + (lambda () + (close-port input) + (dup2 (fileno output) 1) + (dup2 (fileno output) 2) + (apply execlp program program args)) + (lambda () + (primitive-exit 127)))) + (pid + (close-port output) + (values input pid)))))) + +(define (invoke/quiet program . args) + "Invoke PROGRAM with ARGS and capture PROGRAM's standard output and standard +error. If PROGRAM succeeds, print nothing and return the unspecified value; +otherwise, raise a '&message' error condition that includes the status code +and the output of PROGRAM." + (let-values (((pipe pid) + (apply open-pipe-with-stderr program args))) + (let loop ((lines '())) + (match (read-line pipe) + ((? eof-object?) + (close-port pipe) + (match (waitpid pid) + ((_ . status) + (unless (zero? status) + (let-syntax ((G_ (syntax-rules () ;for xgettext + ((_ str) str)))) + (raise (condition + (&message + (message (format #f (G_ "'~a~{ ~a~}' exited \ +with status ~a; output follows:~%~%~{ ~a~%~}") + program args + (or (status:exit-val status) + status) + (reverse lines))))))))))) + (line + (loop (cons line lines))))))) + ;;; ;;; Text substitution (aka. sed). diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index 5172345e5a..9c4b6dedb5 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -37,6 +37,7 @@ gnu/installer/timezone.scm gnu/installer/user.scm gnu/installer/utils.scm gnu/packages/bootstrap.scm +guix/build/utils.scm guix/scripts.scm guix/scripts/build.scm guix/discovery.scm @@ -79,6 +80,4 @@ guix/channels.scm guix/profiles.scm guix/git.scm guix/deprecation.scm -gnu/build/bootloader.scm nix/nix-daemon/guix-daemon.cc - diff --git a/tests/build-utils.scm b/tests/build-utils.scm index 5678bb6a22..61e6c44e63 100644 --- a/tests/build-utils.scm +++ b/tests/build-utils.scm @@ -21,8 +21,6 @@ (define-module (test-build-utils) #:use-module (guix tests) #:use-module (guix build utils) - #:use-module ((gnu build bootloader) - #:select (invoke/quiet)) #:use-module ((guix utils) #:select (%current-system call-with-temporary-directory)) #:use-module (gnu packages) -- cgit v1.2.3 From 9c2563a80b6f1d8fb8677f5314e6180ea9916aa5 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 21 Jun 2019 18:11:25 +0200 Subject: build-system/python: Export 'python-version'. * guix/build/python-build-system.scm (get-python-version): Rename to... (python-version): ... this. Update callers. Make public. * gnu/packages/gstreamer.scm (python-gst)[arguments]: Adjust accordingly. * gnu/packages/machine-learning.scm (ghmm)[arguments]: Likewise. * gnu/packages/openldap.scm (389-ds-base)[arguments]: Import (guix build python-build-system). Use 'python-version'. * gnu/packages/package-management.scm (conda)[arguments]: Use 'python-version'. --- gnu/packages/gstreamer.scm | 4 +--- gnu/packages/machine-learning.scm | 3 +-- gnu/packages/openldap.scm | 13 +++++-------- gnu/packages/package-management.scm | 3 +-- guix/build/python-build-system.scm | 11 ++++++----- 5 files changed, 14 insertions(+), 20 deletions(-) (limited to 'guix/build') diff --git a/gnu/packages/gstreamer.scm b/gnu/packages/gstreamer.scm index 2a818e078c..39a4eb5fc0 100644 --- a/gnu/packages/gstreamer.scm +++ b/gnu/packages/gstreamer.scm @@ -447,9 +447,7 @@ compression formats through the use of the libav library.") (guix build python-build-system)) #:configure-flags (let* ((python (assoc-ref %build-inputs "python")) - (python-version ((@@ (guix build python-build-system) - get-python-version) - python)) + (python-version (python-version python)) (python-sitedir (string-append "lib/python" python-version "/site-packages"))) (list (string-append diff --git a/gnu/packages/machine-learning.scm b/gnu/packages/machine-learning.scm index ba7772f66b..e216b9474a 100644 --- a/gnu/packages/machine-learning.scm +++ b/gnu/packages/machine-learning.scm @@ -210,8 +210,7 @@ classification.") (assoc-ref %standard-phases 'check)) (add-before 'check 'fix-PYTHONPATH (lambda* (#:key inputs outputs #:allow-other-keys) - (let ((python-version ((@@ (guix build python-build-system) - get-python-version) + (let ((python-version (python-version (assoc-ref inputs "python")))) (setenv "PYTHONPATH" (string-append (getenv "PYTHONPATH") diff --git a/gnu/packages/openldap.scm b/gnu/packages/openldap.scm index 43f111cf40..2f80920ed4 100644 --- a/gnu/packages/openldap.scm +++ b/gnu/packages/openldap.scm @@ -211,7 +211,11 @@ servers from Python programs.") (arguments `(#:modules ((srfi srfi-1) (guix build gnu-build-system) + ((guix build python-build-system) + #:select (python-version)) (guix build utils)) + #:imported-modules ((guix build python-build-system) + ,@%gnu-build-system-modules) #:configure-flags (list (string-append "--with-db=" (assoc-ref %build-inputs "bdb")) @@ -263,16 +267,9 @@ servers from Python programs.") (add-after 'unpack 'fix-install-location-of-python-tools (lambda* (#:key inputs outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) - (get-python-version - ;; FIXME: copied from python-build-system - (lambda (python) - (let* ((version (last (string-split python #\-))) - (components (string-split version #\.)) - (major+minor (take components 2))) - (string-join major+minor ".")))) (pythondir (string-append out "/lib/python" - (get-python-version (assoc-ref inputs "python")) + (python-version (assoc-ref inputs "python")) "/site-packages/"))) ;; Install directory must be on PYTHONPATH. (setenv "PYTHONPATH" diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm index e1e7d6a5a0..81b3c321e4 100644 --- a/gnu/packages/package-management.scm +++ b/gnu/packages/package-management.scm @@ -831,8 +831,7 @@ This package provides Conda as a library.") (lambda* (#:key inputs outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) (target (string-append out "/lib/python" - ((@@ (guix build python-build-system) - get-python-version) + (python-version (assoc-ref inputs "python")) "/site-packages/"))) ;; The installer aborts if the target directory is not on diff --git a/guix/build/python-build-system.scm b/guix/build/python-build-system.scm index 7c00306b3e..09bd8465c8 100644 --- a/guix/build/python-build-system.scm +++ b/guix/build/python-build-system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2015, 2016, 2018 Ludovic Courtès +;;; Copyright © 2013, 2015, 2016, 2018, 2019 Ludovic Courtès ;;; Copyright © 2013 Andreas Enge ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2015, 2018 Mark H Weaver @@ -32,6 +32,7 @@ #:export (%standard-phases add-installed-pythonpath site-packages + python-version python-build)) ;; Commentary: @@ -147,7 +148,7 @@ (format #t "test suite not run~%")) #t) -(define (get-python-version python) +(define (python-version python) (let* ((version (last (string-split python #\-))) (components (string-split version #\.)) (major+minor (take components 2))) @@ -158,7 +159,7 @@ (let* ((out (assoc-ref outputs "out")) (python (assoc-ref inputs "python"))) (string-append out "/lib/python" - (get-python-version python) + (python-version python) "/site-packages/"))) (define (add-installed-pythonpath inputs outputs) @@ -202,7 +203,7 @@ when running checks after installing the package." (python (assoc-ref inputs "python")) (var `("PYTHONPATH" prefix ,(cons (string-append out "/lib/python" - (get-python-version python) + (python-version python) "/site-packages") (search-path-as-string->list (or (getenv "PYTHONPATH") "")))))) @@ -222,7 +223,7 @@ installed with setuptools." (let* ((out (assoc-ref outputs "out")) (python (assoc-ref inputs "python")) (site-packages (string-append out "/lib/python" - (get-python-version python) + (python-version python) "/site-packages")) (easy-install-pth (string-append site-packages "/easy-install.pth")) (new-pth (string-append site-packages "/" name ".pth"))) -- cgit v1.2.3 From 25280065814aecd7ce56baf4866b0c05acf8028b Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Sat, 29 Jun 2019 19:13:49 +0200 Subject: build-system/meson: Do not inherit the 'bootstrap' phase. * guix/build/meson-build-system.scm (%standard-phases): Remove 'bootstrap'. * gnu/packages/glib.scm (glib)[arguments]: Adjust accordingly. --- gnu/packages/glib.scm | 1 - guix/build/meson-build-system.scm | 1 + 2 files changed, 1 insertion(+), 1 deletion(-) (limited to 'guix/build') diff --git a/gnu/packages/glib.scm b/gnu/packages/glib.scm index 62543fe114..eae8297531 100644 --- a/gnu/packages/glib.scm +++ b/gnu/packages/glib.scm @@ -200,7 +200,6 @@ shared NFS home directories.") (arguments `(#:phases (modify-phases %standard-phases - (delete 'bootstrap) (add-before 'build 'pre-build (lambda* (#:key inputs outputs #:allow-other-keys) ;; For tests/gdatetime.c. diff --git a/guix/build/meson-build-system.scm b/guix/build/meson-build-system.scm index d0975fcab0..8043a84abb 100644 --- a/guix/build/meson-build-system.scm +++ b/guix/build/meson-build-system.scm @@ -108,6 +108,7 @@ for example libraries only needed for the tests." ;; from the gnu-build-system. If the glib-or-gtk? key is #f (the default) ;; then the extra phases will be removed again in (guix build-system meson). (modify-phases glib-or-gtk:%standard-phases + (delete 'bootstrap) (replace 'configure configure) (replace 'build build) (replace 'check check) -- cgit v1.2.3 From 209214aaefc4248173226a2664ae6dda698b85bb Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Fri, 21 Jun 2019 09:32:38 +0200 Subject: gnu: make-bootstrap: Remove obsolete header file. * guix/build/make-bootstrap.scm (copy-linux-headers): Do not install 'a.out.h'. --- guix/build/make-bootstrap.scm | 1 - 1 file changed, 1 deletion(-) (limited to 'guix/build') diff --git a/guix/build/make-bootstrap.scm b/guix/build/make-bootstrap.scm index e5ef1d6d2b..0d29338ce3 100644 --- a/guix/build/make-bootstrap.scm +++ b/guix/build/make-bootstrap.scm @@ -47,7 +47,6 @@ bootstrap libc." (install-file (pk 'src (string-append kernel-headers "/include/linux/" file)) (pk 'dest (string-append incdir "/linux")))) '( - "a.out.h" ; for 2.2.5 "atalk.h" ; for 2.2.5 "errno.h" "falloc.h" -- cgit v1.2.3 From 6005440d988b331db5ea11a475973cee9a5acce6 Mon Sep 17 00:00:00 2001 From: Leo Famulari Date: Sat, 13 Jul 2019 19:50:16 -0400 Subject: build-system/go: Fix typo. * guix/build/go-build-system.scm (install): Fix typo. --- guix/build/go-build-system.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix/build') diff --git a/guix/build/go-build-system.scm b/guix/build/go-build-system.scm index 858068ba98..acaf06b7b8 100644 --- a/guix/build/go-build-system.scm +++ b/guix/build/go-build-system.scm @@ -234,7 +234,7 @@ unpacking." "Install the source code of IMPORT-PATH to the primary output directory. Compiled executable files (Go \"commands\") should have already been installed to the store based on $GOBIN in the build phase. -XXX We can't make us of compiled libraries (Go \"packages\")." +XXX We can't make use of compiled libraries (Go \"packages\")." (when install-source? (if (string-null? import-path) ((display "WARNING: The Go import path is unset.\n"))) -- cgit v1.2.3 From 96783ed6275cd2818ff56916274e6e4582f1dc9b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 19 Jul 2019 00:52:36 +0200 Subject: syscalls: 'define-as-needed' does not re-export local variables. Fixes . Reported by Timothy Sample . * guix/build/syscalls.scm (define-as-needed): Rewrite to use lower-level module primitives; define VARIABLE only if it's not already defined to avoid "re-exporting local variable" error. --- guix/build/syscalls.scm | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 3c84d3893f..f2fdb4d9d1 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -396,17 +396,11 @@ the returned procedure is called." ((_ (proc args ...) body ...) (define-as-needed proc (lambda* (args ...) body ...))) ((_ variable value) - (begin - (when (module-defined? the-scm-module 'variable) - (re-export variable)) - - (define variable - (if (module-defined? the-scm-module 'variable) - (module-ref the-scm-module 'variable) - value)) - - (unless (module-defined? the-scm-module 'variable) - (export variable)))))) + (if (module-defined? the-scm-module 'variable) + (module-re-export! (current-module) '(variable)) + (begin + (module-define! (current-module) 'variable value) + (module-export! (current-module) '(variable))))))) ;;; -- cgit v1.2.3 From 4f3811f6bbdfba817601eb3168f5b3e0d2f1c3f6 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sun, 9 Sep 2018 11:42:29 +0200 Subject: guix: copy-linux-headers: Extract procedure, add headers. * guix/build/make-bootstrap.scm (copy-linux-headers): New procedure; extract from make-stripped-libc and add headers for Mes bootstrap. (make-stripped-libc): Use it. --- guix/build/make-bootstrap.scm | 72 +++++++++++++++++++++++++++++++------------ 1 file changed, 53 insertions(+), 19 deletions(-) (limited to 'guix/build') diff --git a/guix/build/make-bootstrap.scm b/guix/build/make-bootstrap.scm index 48799f7e90..e5ef1d6d2b 100644 --- a/guix/build/make-bootstrap.scm +++ b/guix/build/make-bootstrap.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015, 2017 Manolis Fragkiskos Ragkousis ;;; Copyright © 2015, 2019 Ludovic Courtès +;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,7 +24,8 @@ #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:use-module (guix build utils) - #:export (make-stripped-libc)) + #:export (copy-linux-headers + make-stripped-libc)) ;; Commentary: ;; @@ -31,6 +33,53 @@ ;; ;; Code: +(define (copy-linux-headers output kernel-headers) + "Copy to OUTPUT the subset of KERNEL-HEADERS that is needed when producing a +bootstrap libc." + + (let* ((incdir (string-append output "/include"))) + (mkdir-p incdir) + + ;; Copy some of the Linux-Libre headers that glibc headers + ;; refer to. + (mkdir (string-append incdir "/linux")) + (for-each (lambda (file) + (install-file (pk 'src (string-append kernel-headers "/include/linux/" file)) + (pk 'dest (string-append incdir "/linux")))) + '( + "a.out.h" ; for 2.2.5 + "atalk.h" ; for 2.2.5 + "errno.h" + "falloc.h" + "if_addr.h" ; for 2.16.0 + "if_ether.h" ; for 2.2.5 + "if_link.h" ; for 2.16.0 + "ioctl.h" + "kernel.h" + "limits.h" + "neighbour.h" ; for 2.16.0 + "netlink.h" ; for 2.16.0 + "param.h" + "prctl.h" ; for 2.16.0 + "posix_types.h" + "rtnetlink.h" ; for 2.16.0 + "socket.h" + "stddef.h" + "swab.h" ; for 2.2.5 + "sysctl.h" + "sysinfo.h" ; for 2.2.5 + "types.h" + "version.h" ; for 2.2.5 + )) + + (copy-recursively (string-append kernel-headers "/include/asm") + (string-append incdir "/asm")) + (copy-recursively (string-append kernel-headers "/include/asm-generic") + (string-append incdir "/asm-generic")) + (copy-recursively (string-append kernel-headers "/include/linux/byteorder") + (string-append incdir "/linux/byteorder")) + #t)) + (define (make-stripped-libc output libc kernel-headers) "Copy to OUTPUT the subset of LIBC and KERNEL-HEADERS that is needed when producing a bootstrap libc." @@ -43,25 +92,10 @@ when producing a bootstrap libc." (string-append incdir "/mach")) #t)) - (define (copy-linux-headers output kernel-headers) + (define (copy-libc+linux-headers output kernel-headers) (let* ((incdir (string-append output "/include"))) (copy-recursively (string-append libc "/include") incdir) - - ;; Copy some of the Linux-Libre headers that glibc headers - ;; refer to. - (mkdir (string-append incdir "/linux")) - (for-each (lambda (file) - (install-file (string-append kernel-headers "/include/linux/" file) - (string-append incdir "/linux"))) - '("limits.h" "errno.h" "socket.h" "kernel.h" - "sysctl.h" "param.h" "ioctl.h" "types.h" - "posix_types.h" "stddef.h" "falloc.h")) - - (copy-recursively (string-append kernel-headers "/include/asm") - (string-append incdir "/asm")) - (copy-recursively (string-append kernel-headers "/include/asm-generic") - (string-append incdir "/asm-generic")) - #t)) + (copy-linux-headers output kernel-headers))) (define %libc-object-files-rx "^(crt.*|ld.*|lib(c|m|dl|rt|pthread|nsl|\ util).*\\.so(\\..*)?|lib(machuser|hurduser).so.*|(libc(rt|)|libpthread)\ @@ -80,6 +114,6 @@ _nonshared\\.a)$") (if (directory-exists? (string-append kernel-headers "/include/mach")) (copy-mach-headers output kernel-headers) - (copy-linux-headers output kernel-headers))) + (copy-libc+linux-headers output kernel-headers))) -- cgit v1.2.3 From 3762e31b6c8089928aad3186f70f157502950e3b Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Thu, 22 Aug 2019 16:21:26 +0300 Subject: build/cargo-build-system: Remove 'update-cargo-lock phase. * guix/build/cargo-build-system.scm (update-cargo-lock): Remove procedure. (configure): Delete Cargo.lock file if it exists. (%standard-phases): Remove 'update-cargo-lock. * doc/guix.texi (Build System)[cargo-build-system]: Remove references to the 'update-cargo-lock phase. --- doc/guix.texi | 9 ++++----- guix/build/cargo-build-system.scm | 19 ++++--------------- 2 files changed, 8 insertions(+), 20 deletions(-) (limited to 'guix/build') diff --git a/doc/guix.texi b/doc/guix.texi index 90b2deb251..707c2ba700 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5854,11 +5854,10 @@ should be added to the package definition via the In its @code{configure} phase, this build system will make any source inputs specified in the @code{#:cargo-inputs} and @code{#:cargo-development-inputs} -parameters available to cargo. The @code{update-cargo-lock} phase will, -when there is a @code{Cargo.lock} file, update the @code{Cargo.lock} file -with the inputs and their versions available at build time. The -@code{install} phase installs any crate the binaries if they are defined by -the crate. +parameters available to cargo. It will also remove an included +@code{Cargo.lock} file to be recreated by @code{cargo} during the +@code{build} phase. The @code{install} phase installs any crate the binaries +if they are defined by the crate. @end defvr @cindex Clojure (programming language) diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm index 7d363a18a5..06ed14b89f 100644 --- a/guix/build/cargo-build-system.scm +++ b/guix/build/cargo-build-system.scm @@ -134,22 +134,12 @@ directory = '" port) ;; upgrading the compiler for example. (setenv "RUSTFLAGS" "--cap-lints allow") (setenv "CC" (string-append (assoc-ref inputs "gcc") "/bin/gcc")) - #t) -;; The Cargo.lock file tells the build system which crates are required for -;; building and hardcodes their version and checksum. In order to build with -;; the inputs we provide, we need to recreate the file with our inputs. -(define* (update-cargo-lock #:key - (vendor-dir "guix-vendor") - #:allow-other-keys) - "Regenerate the Cargo.lock file with the current build inputs." + ;; We don't use the Cargo.lock file to determine the package versions we use + ;; during building, and in any case if one is not present it is created + ;; during the 'build phase by cargo. (when (file-exists? "Cargo.lock") - (begin - ;; Unfortunately we can't generate a Cargo.lock file until the checksums - ;; are generated, so we have an extra round of generate-all-checksums here. - (generate-all-checksums vendor-dir) - (delete-file "Cargo.lock") - (invoke "cargo" "generate-lockfile"))) + (delete-file "Cargo.lock")) #t) ;; After the 'patch-generated-file-shebangs phase any vendored crates who have @@ -203,7 +193,6 @@ directory = '" port) (replace 'build build) (replace 'check check) (replace 'install install) - (add-after 'configure 'update-cargo-lock update-cargo-lock) (add-after 'patch-generated-file-shebangs 'patch-cargo-checksums patch-cargo-checksums))) (define* (cargo-build #:key inputs (phases %standard-phases) -- cgit v1.2.3 From 2f43e5db1c36ec93a80ed1e3cbe763a8d64adcb5 Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Mon, 2 Sep 2019 11:07:53 +0300 Subject: build/cargo-build-system: Use invoke. * guix/build/cargo-build-system.scm (crate-src?, build, check, install): Use 'invoke'. --- guix/build/cargo-build-system.scm | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'guix/build') diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm index 06ed14b89f..f173b64c83 100644 --- a/guix/build/cargo-build-system.scm +++ b/guix/build/cargo-build-system.scm @@ -81,10 +81,10 @@ Cargo.toml file present at its root." ;; archive, but not nested anywhere else). We do this by cutting up ;; each output line and only looking at the second component. We then ;; check if it matches Cargo.toml exactly and short circuit if it does. - (zero? (apply system* (list "sh" "-c" - (string-append "tar -tf " path - " | cut -d/ -f2" - " | grep -q '^Cargo.toml$'")))))) + (apply invoke (list "sh" "-c" + (string-append "tar -tf " path + " | cut -d/ -f2" + " | grep -q '^Cargo.toml$'"))))) (define* (configure #:key inputs (vendor-dir "guix-vendor") @@ -157,7 +157,7 @@ directory = '" port) #:allow-other-keys) "Build a given Cargo package." (or skip-build? - (zero? (apply system* `("cargo" "build" ,@cargo-build-flags))))) + (apply invoke `("cargo" "build" ,@cargo-build-flags)))) (define* (check #:key tests? @@ -165,7 +165,7 @@ directory = '" port) #:allow-other-keys) "Run tests for a given Cargo package." (if tests? - (zero? (apply system* `("cargo" "test" ,@cargo-test-flags))) + (apply invoke `("cargo" "test" ,@cargo-test-flags)) #t)) (define (touch file-name) @@ -184,7 +184,7 @@ directory = '" port) ;; otherwise cargo will raise an error. (or skip-build? (not (has-executable-target?)) - (zero? (system* "cargo" "install" "--path" "." "--root" out))))) + (invoke "cargo" "install" "--path" "." "--root" out)))) (define %standard-phases (modify-phases gnu:%standard-phases -- cgit v1.2.3 From a44a535ebecd40c52514623a44d31d927ecca9da Mon Sep 17 00:00:00 2001 From: nixo Date: Mon, 29 Jul 2019 18:45:26 +0200 Subject: build: Add julia-build-system. * guix/build/julia-build-system.scm: New file. * guix/build-system/julia.scm: New file. * Makefile.am (MODULES): Add them. * doc/guix.texi (Build Systems): Document julia-build-system. Signed-off-by: Julien Lepiller --- Makefile.am | 2 + doc/guix.texi | 23 +++++++ guix/build-system/julia.scm | 132 +++++++++++++++++++++++++++++++++++++ guix/build/julia-build-system.scm | 135 ++++++++++++++++++++++++++++++++++++++ 4 files changed, 292 insertions(+) create mode 100644 guix/build-system/julia.scm create mode 100644 guix/build/julia-build-system.scm (limited to 'guix/build') diff --git a/Makefile.am b/Makefile.am index 7b96c9473c..796e96f099 100644 --- a/Makefile.am +++ b/Makefile.am @@ -126,6 +126,7 @@ MODULES = \ guix/build-system/gnu.scm \ guix/build-system/guile.scm \ guix/build-system/haskell.scm \ + guix/build-system/julia.scm \ guix/build-system/linux-module.scm \ guix/build-system/node.scm \ guix/build-system/perl.scm \ @@ -184,6 +185,7 @@ MODULES = \ guix/build/texlive-build-system.scm \ guix/build/waf-build-system.scm \ guix/build/haskell-build-system.scm \ + guix/build/julia-build-system.scm \ guix/build/linux-module-build-system.scm \ guix/build/store-copy.scm \ guix/build/json.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index a078822871..6d6a09b36b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6034,6 +6034,29 @@ Packages built with @code{guile-build-system} must provide a Guile package in their @code{native-inputs} field. @end defvr +@defvr {Scheme Variable} julia-build-system +This variable is exported by @code{(guix build-system julia)}. It implements +the build procedure used by @uref{https://julialang.org/, julia} packages, +which essentially is similar to running @command{julia -e 'using Pkg; +Pkg.add(package)'} in an environment where @code{JULIA_LOAD_PATH} contains the +paths to all Julia package inputs. Tests are run not run. + +Julia packages require the source @code{file-name} to be the real name of the +package, correctly capitalized. + +For packages requiring shared library dependencies, you may need to write the +@file{/deps/deps.jl} file manually. It's usually a line of @code{const +variable = /gnu/store/libary.so} for each dependency, plus a void function +@code{check_deps() = nothing}. + +Some older packages that aren't using @file{Package.toml} yet, will require +this file to be created, too. The function @code{julia-create-package-toml} +helps creating the file. You need to pass the outputs and the source of the +package, it's name (the same as the @code{file-name} parameter), the package +uuid, the package version, and a list of dependencies specified by their name +and their uuid. +@end defvr + @defvr {Scheme Variable} minify-build-system This variable is exported by @code{(guix build-system minify)}. It implements a minification procedure for simple JavaScript packages. diff --git a/guix/build-system/julia.scm b/guix/build-system/julia.scm new file mode 100644 index 0000000000..50237905ec --- /dev/null +++ b/guix/build-system/julia.scm @@ -0,0 +1,132 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Nicolò Balzarotti +;;; +;;; 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 . + +(define-module (guix build-system julia) + #:use-module ((guix build julia-build-system)) + #:use-module (gnu packages julia) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (guix packages) + #:use-module (guix derivations) + #:use-module (guix search-paths) + #:use-module (guix build-system) + #:use-module (guix build-system gnu) + #:use-module (ice-9 match) + #:use-module (srfi srfi-26) + #:export (%julia-build-system-modules + julia-build + julia-build-system)) + +;; Commentary: +;; +;; Standard build procedure for Julia packages. +;; +;; Code: + +(define %julia-build-system-modules + ;; Build-side modules imported by default. + `((guix build julia-build-system) + ,@%gnu-build-system-modules)) + +(define (default-julia) + "Return the default Julia package." + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((julia-mod (resolve-interface '(gnu packages julia)))) + (module-ref julia-mod 'julia))) + +(define* (lower name + #:key source inputs native-inputs outputs system target + (julia julia) + #:allow-other-keys + #:rest arguments) + "Return a bag for NAME." + (define private-keywords + '(#:target #:julia #:inputs #:native-inputs)) + + (and (not target) ;XXX: no cross-compilation + (bag + (name name) + (system system) + (host-inputs `(,@(if source + `(("source" ,source)) + '()) + ,@inputs + + ;; Keep the standard inputs of 'gnu-build-system'. + ,@(standard-packages))) + (build-inputs `(("julia" ,julia) + ,@native-inputs)) + (outputs outputs) + (build julia-build) + (arguments (strip-keyword-arguments private-keywords arguments))))) + +(define* (julia-build store name inputs + #:key source + (tests? #f) + (phases '(@ (guix build julia-build-system) + %standard-phases)) + (outputs '("out")) + (search-paths '()) + (system (%current-system)) + (guile #f) + (imported-modules %julia-build-system-modules) + (modules '((guix build julia-build-system) + (guix build utils)))) + "Build SOURCE using Julia, and with INPUTS." + (define builder + `(begin + (use-modules ,@modules) + (julia-build #:name ,name + #:source ,(match (assoc-ref inputs "source") + (((? derivation? source)) + (derivation->output-path source)) + ((source) + source) + (source + source)) + #:system ,system + #:tests? ,tests? + #:phases ,phases + #:outputs %outputs + #:search-paths ',(map search-path-specification->sexp + search-paths) + #:inputs %build-inputs))) + + (define guile-for-build + (match guile + ((? package?) + (package-derivation store guile system #:graft? #f)) + (#f ; the default + (let* ((distro (resolve-interface '(gnu packages commencement))) + (guile (module-ref distro 'guile-final))) + (package-derivation store guile system #:graft? #f))))) + + (build-expression->derivation store name builder + #:inputs inputs + #:system system + #:modules imported-modules + #:outputs outputs + #:guile-for-build guile-for-build)) + +(define julia-build-system + (build-system + (name 'julia) + (description "The build system for Julia packages") + (lower lower))) + +;;; julia.scm ends here diff --git a/guix/build/julia-build-system.scm b/guix/build/julia-build-system.scm new file mode 100644 index 0000000000..ff6fcf5fe3 --- /dev/null +++ b/guix/build/julia-build-system.scm @@ -0,0 +1,135 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Nicolò Balzarotti +;;; +;;; 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 . + + +(define-module (guix build julia-build-system) + #:use-module ((guix build gnu-build-system) #:prefix gnu:) + #:use-module (guix build utils) + #:use-module (ice-9 match) + #:export (%standard-phases + julia-create-package-toml + julia-build)) + +;; Commentary: +;; +;; Builder-side code of the standard build procedure for Julia packages. +;; +;; Code: + +(define (invoke-julia code) + (invoke "julia" "-e" code)) + +;; subpath where we store the package content +(define %package-path "/share/julia/packages/") + +(define (generate-load-path inputs outputs) + (string-append + (string-join (map (match-lambda + ((_ . path) + (string-append path %package-path))) + ;; Restrict to inputs beginning with "julia-". + (filter (match-lambda + ((name . _) + (string-prefix? "julia-" name))) + inputs)) + ":") + (string-append ":" (assoc-ref outputs "out") %package-path) + ;; stdlib is always required to find Julia's standard libraries. + ;; usually there are other two paths in this variable: + ;; "@" and "@v#.#" + ":@stdlib")) + +(define* (install #:key source inputs outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (package-dir (string-append out %package-path + (string-append + (strip-store-file-name source))))) + (setenv "JULIA_LOAD_PATH" (generate-load-path inputs outputs)) + (mkdir-p package-dir) + (copy-recursively source package-dir)) + #t) + +;; TODO: Precompilation is working, but I don't know how to tell +;; julia to use use it. If (on rantime) we set HOME to +;; store path, julia tries to write files there (failing) +(define* (precompile #:key source inputs outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (builddir (string-append out "/share/julia/")) + (package (strip-store-file-name source))) + (mkdir-p builddir) + (setenv "JULIA_DEPOT_PATH" builddir) + (setenv "JULIA_LOAD_PATH" (generate-load-path inputs outputs)) + ;; Actual precompilation + (invoke-julia (string-append "using " package))) + #t) + +(define* (check #:key source inputs outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (package (strip-store-file-name source)) + (builddir (string-append out "/share/julia/"))) + (setenv "JULIA_DEPOT_PATH" builddir) + (setenv "JULIA_LOAD_PATH" (generate-load-path inputs outputs)) + (invoke-julia (string-append "using Pkg;Pkg.test(\"" package "\")"))) + #t) + +(define (julia-create-package-toml outputs source + name uuid version + deps) + "Some packages are not using the new Package.toml dependency specifications. +Write this file manually, so that Julia can find its dependencies." + (let ((f (open-file + (string-append + (assoc-ref outputs "out") + %package-path + (string-append + name "/Project.toml")) + "w"))) + (display (string-append + " +name = \"" name "\" +uuid = \"" uuid "\" +version = \"" version "\" +") f) + (when (not (null? deps)) + (display "[deps]\n" f) + (for-each (lambda dep + (display (string-append (car (car dep)) " = \"" (cdr (car dep)) "\"\n") + f)) + deps)) + (close-port f)) + #t) + +(define %standard-phases + (modify-phases gnu:%standard-phases + (delete 'check) ; tests must be run after installation + (replace 'install install) + (add-after 'install 'precompile precompile) + ;; (add-after 'install 'check check) + ;; TODO: In the future we could add a "system-image-generation" phase + ;; where we use PackageCompiler.jl to speed up package loading times + (delete 'configure) + (delete 'bootstrap) + (delete 'patch-usr-bin-file) + (delete 'build))) + +(define* (julia-build #:key inputs (phases %standard-phases) + #:allow-other-keys #:rest args) + "Build the given Julia package, applying all of PHASES in order." + (apply gnu:gnu-build + #:inputs inputs #:phases phases + args)) -- cgit v1.2.3 From 01e38cc4264d9d0076ce9d894796ceff1f08b35a Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Mon, 2 Sep 2019 15:47:42 +0200 Subject: build-system/asdf: Add option to compress programs. * guix/build/lisp-utils.scm (build-program): Add `compress?' key argument. (generate-executable-for-system): Same. (generate-executable): Same. --- guix/build/lisp-utils.scm | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) (limited to 'guix/build') diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm index 97bc6197a3..c7a589c902 100644 --- a/guix/build/lisp-utils.scm +++ b/guix/build/lisp-utils.scm @@ -220,12 +220,19 @@ Also load TEST-ASD-FILE if necessary." "Return a lisp keyword for the concatenation of STRINGS." (string->symbol (apply string-append ":" strings))) -(define (generate-executable-for-system type system) +(define* (generate-executable-for-system type system #:key compress?) "Use LISP to generate an executable, whose TYPE can be 'asdf:image-op or 'asdf:program-op. The latter will always be standalone. Depends on having created a \"SYSTEM-exec\" system which contains the entry program." (lisp-eval-program `((require :asdf) + ;; Only SBCL supports compression as of 2019-09-02. + ,(if (and compress? (string=? (%lisp-type) "sbcl")) + '(defmethod asdf:perform ((o asdf:image-op) (c asdf:system)) + (uiop:dump-image (asdf:output-file o c) + :executable t + :compression t)) + '()) (asdf:operate ',type ,(string-append system "-exec"))))) (define (generate-executable-wrapper-system system dependencies) @@ -339,6 +346,7 @@ which are not nested." (dependency-prefixes (list (library-output outputs))) (dependencies (list (basename program))) entry-program + compress? #:allow-other-keys) "Generate an executable program containing all DEPENDENCIES, and which will execute ENTRY-PROGRAM. The result is placed in PROGRAM. When executed, it @@ -350,6 +358,7 @@ retained." #:dependencies dependencies #:dependency-prefixes dependency-prefixes #:entry-program entry-program + #:compress? compress? #:type 'asdf:program-op) (let* ((name (basename program)) (bin-directory (dirname program))) @@ -382,6 +391,7 @@ DEPENDENCY-PREFIXES to ensure references to those libraries are retained." dependency-prefixes entry-program type + compress? #:allow-other-keys) "Generate an executable by using asdf operation TYPE, containing whithin the image all DEPENDENCIES, and running ENTRY-PROGRAM in the case of an @@ -405,7 +415,7 @@ references to those libraries are retained." `(((,bin-directory :**/ :*.*.*) (,bin-directory :**/ :*.*.*))))))) - (generate-executable-for-system type name) + (generate-executable-for-system type name #:compress? compress?) (let* ((after-store-prefix-index (string-index out-file #\/ -- cgit v1.2.3 From f58b2f38e4dfdbb8473fb2816d44fae6ad9cbc79 Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Thu, 12 Sep 2019 20:20:26 +0300 Subject: build: cargo-build-system: Strip store hash from vendor-dir. * guix/build/cargo-build-system.scm (configure): When copying the sources into the vendor-dir strip off the hash before the package name. --- guix/build/cargo-build-system.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix/build') diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm index f173b64c83..0134997c27 100644 --- a/guix/build/cargo-build-system.scm +++ b/guix/build/cargo-build-system.scm @@ -99,7 +99,7 @@ Cargo.toml file present at its root." (for-each (match-lambda ((name . path) - (let* ((basepath (basename path)) + (let* ((basepath (string-drop (basename path) 33)) (crate-dir (string-append vendor-dir "/" basepath))) (and (crate-src? path) ;; Gracefully handle duplicate inputs -- cgit v1.2.3 From 43ffa11fdc4de4197a1096f6ebc4067115f9eb26 Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Fri, 13 Sep 2019 15:05:10 +0300 Subject: build-system/cargo: Use 'strip-store-file-name'. This is a follow-up to f58b2f38e4dfdbb8473fb2816d44fae6ad9cbc79. * guix/build/cargo-build-system.scm (configure): Use bespoke 'strip-store-file-name' function. --- guix/build/cargo-build-system.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix/build') diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm index 0134997c27..c69cae5afd 100644 --- a/guix/build/cargo-build-system.scm +++ b/guix/build/cargo-build-system.scm @@ -99,7 +99,7 @@ Cargo.toml file present at its root." (for-each (match-lambda ((name . path) - (let* ((basepath (string-drop (basename path) 33)) + (let* ((basepath (strip-store-file-name path)) (crate-dir (string-append vendor-dir "/" basepath))) (and (crate-src? path) ;; Gracefully handle duplicate inputs -- cgit v1.2.3 From 3af85f832dd007296ec64ddc34beadd397481311 Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Fri, 13 Sep 2019 15:09:34 +0300 Subject: build-system/cargo: Remove unused function. * guix/build/cargo-build-system.scm (touch): Remove it. --- guix/build/cargo-build-system.scm | 3 --- 1 file changed, 3 deletions(-) (limited to 'guix/build') diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm index c69cae5afd..4be5443083 100644 --- a/guix/build/cargo-build-system.scm +++ b/guix/build/cargo-build-system.scm @@ -168,9 +168,6 @@ directory = '" port) (apply invoke `("cargo" "test" ,@cargo-test-flags)) #t)) -(define (touch file-name) - (call-with-output-file file-name (const #t))) - (define* (install #:key inputs outputs skip-build? #:allow-other-keys) "Install a given Cargo package." (let* ((out (assoc-ref outputs "out"))) -- cgit v1.2.3 From 5da7a04abddcd9c8805131ff27abbfe2b3f1fd33 Mon Sep 17 00:00:00 2001 From: Vagrant Cascadian Date: Mon, 23 Sep 2019 12:08:13 -0700 Subject: build: ruby-build-system: Fix typo. * guix/build/ruby-build-system: Fix spelling of "invocation". --- guix/build/ruby-build-system.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix/build') diff --git a/guix/build/ruby-build-system.scm b/guix/build/ruby-build-system.scm index 63c94765f7..c957a61115 100644 --- a/guix/build/ruby-build-system.scm +++ b/guix/build/ruby-build-system.scm @@ -128,7 +128,7 @@ is #f." (define* (install #:key inputs outputs (gem-flags '()) #:allow-other-keys) "Install the gem archive SOURCE to the output store item. Additional -GEM-FLAGS are passed to the 'gem' invokation, if present." +GEM-FLAGS are passed to the 'gem' invocation, if present." (let* ((ruby-version (match:substring (string-match "ruby-(.*)\\.[0-9]$" (assoc-ref inputs "ruby")) -- cgit v1.2.3 From 21391f8c83658797c9bfbc3ef8a552859e9d861d Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Tue, 24 Sep 2019 20:57:34 -0500 Subject: compile: Fix race condition on completion progress. This prevent a race condition where multiple compilation threads could report the same progress. * guix/build/compile.scm (compile-files): Rename to... : ...this. Increment in same mutex region as the compilation is reported. --- guix/build/compile.scm | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) (limited to 'guix/build') diff --git a/guix/build/compile.scm b/guix/build/compile.scm index c127456fd0..06ed57c9d7 100644 --- a/guix/build/compile.scm +++ b/guix/build/compile.scm @@ -169,11 +169,12 @@ BUILD-DIRECTORY, using up to WORKERS parallel workers. The resulting object files are for HOST, a GNU triplet such as \"x86_64-linux-gnu\"." (define progress-lock (make-mutex)) (define total (length files)) - (define completed 0) + (define progress 0) (define (build file) (with-mutex progress-lock - (report-compilation file total completed)) + (report-compilation file total progress) + (set! progress (+ 1 progress))) ;; Exit as soon as something goes wrong. (exit-on-exception @@ -185,9 +186,7 @@ files are for HOST, a GNU triplet such as \"x86_64-linux-gnu\"." #:output-file (string-append build-directory "/" (scm->go relative)) #:opts (append warning-options - (optimization-options relative))))))) - (with-mutex progress-lock - (set! completed (+ 1 completed)))) + (optimization-options relative)))))))) (with-augmented-search-path %load-path source-directory (with-augmented-search-path %load-compiled-path build-directory -- cgit v1.2.3 From 7089f98ef1c274f1607ec314f3a16bd3c3ac89a4 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 19 Jul 2019 00:52:36 +0200 Subject: syscalls: 'define-as-needed' does not re-export local variables. Fixes . Reported by Timothy Sample . * guix/build/syscalls.scm (define-as-needed): Rewrite to use lower-level module primitives; define VARIABLE only if it's not already defined to avoid "re-exporting local variable" error. --- guix/build/syscalls.scm | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 3c84d3893f..f2fdb4d9d1 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -396,17 +396,11 @@ the returned procedure is called." ((_ (proc args ...) body ...) (define-as-needed proc (lambda* (args ...) body ...))) ((_ variable value) - (begin - (when (module-defined? the-scm-module 'variable) - (re-export variable)) - - (define variable - (if (module-defined? the-scm-module 'variable) - (module-ref the-scm-module 'variable) - value)) - - (unless (module-defined? the-scm-module 'variable) - (export variable)))))) + (if (module-defined? the-scm-module 'variable) + (module-re-export! (current-module) '(variable)) + (begin + (module-define! (current-module) 'variable value) + (module-export! (current-module) '(variable))))))) ;;; -- cgit v1.2.3 From 5e5f7167943b408ae55736a44908a82056c87780 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 5 Oct 2019 21:54:31 +0200 Subject: syscalls: Add 'add-to-entropy-count'. * guix/build/syscalls.scm (RNDADDTOENTCNT): New variable. (add-to-entropy-count): New procedure. * tests/syscalls.scm ("add-to-entropy-count"): New test. --- guix/build/syscalls.scm | 28 ++++++++++++++++++++++++++++ tests/syscalls.scm | 13 +++++++++++++ 2 files changed, 41 insertions(+) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index f2fdb4d9d1..bbf2531c79 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -68,6 +68,7 @@ statfs free-disk-space device-in-use? + add-to-entropy-count processes mkdtemp! @@ -706,6 +707,33 @@ backend device." (list (strerror err)) (list err)))))) + +;;; +;;; Random. +;;; + +;; From . +(define RNDADDTOENTCNT #x40045201) + +(define (add-to-entropy-count port-or-fd n) + "Add N to the kernel's entropy count (the value that can be read from +/proc/sys/kernel/random/entropy_avail). PORT-OR-FD must correspond to +/dev/urandom or /dev/random. Raise to 'system-error with EPERM when the +caller lacks root privileges." + (let ((fd (if (port? port-or-fd) + (fileno port-or-fd) + port-or-fd)) + (box (make-bytevector (sizeof int)))) + (bytevector-sint-set! box 0 n (native-endianness) + (sizeof int)) + (let-values (((ret err) + (%ioctl fd RNDADDTOENTCNT + (bytevector->pointer box)))) + (unless (zero? err) + (throw 'system-error "add-to-entropy-count" "~A" + (list (strerror err)) + (list err)))))) + ;;; ;;; Containers. diff --git a/tests/syscalls.scm b/tests/syscalls.scm index eeb223b950..1b3121e503 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -567,6 +567,19 @@ (let ((result (call-with-input-file "/var/run/utmpx" read-utmpx))) (or (utmpx? result) (eof-object? result)))) +(when (zero? (getuid)) + (test-skip 1)) +(test-equal "add-to-entropy-count" + EPERM + (call-with-output-file "/dev/urandom" + (lambda (port) + (catch 'system-error + (lambda () + (add-to-entropy-count port 77) + #f) + (lambda args + (system-error-errno args)))))) + (test-end) (false-if-exception (delete-file temp-file)) -- cgit v1.2.3