diff options
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/build-system/dub.scm | 9 | ||||
| -rw-r--r-- | guix/build/chicken-build-system.scm | 12 | ||||
| -rw-r--r-- | guix/build/dub-build-system.scm | 26 | ||||
| -rw-r--r-- | guix/scripts/refresh.scm | 22 | ||||
| -rw-r--r-- | guix/scripts/style.scm | 3 | ||||
| -rwxr-xr-x | guix/scripts/substitute.scm | 102 | ||||
| -rw-r--r-- | guix/scripts/system.scm | 11 | ||||
| -rw-r--r-- | guix/self.scm | 5 | ||||
| -rw-r--r-- | guix/status.scm | 16 | ||||
| -rw-r--r-- | guix/utils.scm | 6 |
10 files changed, 112 insertions, 100 deletions
diff --git a/guix/build-system/dub.scm b/guix/build-system/dub.scm index 55ad7decb8..8aa93d5b0f 100644 --- a/guix/build-system/dub.scm +++ b/guix/build-system/dub.scm @@ -51,6 +51,13 @@ (let ((pkg-config (resolve-interface '(gnu packages pkg-config)))) (module-ref pkg-config 'pkg-config))) +(define (default-ld-gold-wrapper) + "Return the default ld-gold-wrapper package." + ;; LDC doesn't work with Guix's default (BFD) linker. + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((commencement (resolve-interface '(gnu packages commencement)))) + (module-ref commencement 'ld-gold-wrapper))) + (define %dub-build-system-modules ;; Build-side modules imported by default. `((guix build dub-build-system) @@ -100,6 +107,7 @@ (ldc (default-ldc)) (dub (default-dub)) (pkg-config (default-pkg-config)) + (ld-gold-wrapper (default-ld-gold-wrapper)) #:allow-other-keys #:rest arguments) "Return a bag for NAME." @@ -121,6 +129,7 @@ ,@(standard-packages))) (build-inputs `(("ldc" ,ldc) ("dub" ,dub) + ("ld-gold-wrapper" ,ld-gold-wrapper) ,@native-inputs)) (outputs outputs) (build dub-build) diff --git a/guix/build/chicken-build-system.scm b/guix/build/chicken-build-system.scm index 5db9906acf..a669822dad 100644 --- a/guix/build/chicken-build-system.scm +++ b/guix/build/chicken-build-system.scm @@ -112,6 +112,17 @@ unpacking." (when tests? (invoke "chicken-install" "-cached" "-test" "-no-install" egg-name))) +(define* (stamp-egg-version #:key egg-name name #:allow-other-keys) + "Check if EGG-NAME.egg contains version information and add some if not." + (let* ((filename (string-append egg-name "/" egg-name ".egg")) + (egg-info (call-with-input-file filename read)) + (ver? (find (lambda (i) (eqv? (car i) 'version)) egg-info)) + (ver (substring name (1+ (string-rindex name #\-))))) + (when (not ver?) + (make-file-writable filename) + (call-with-output-file filename + (lambda (f) (write (cons `(version ,ver) egg-info) f)))))) + ;; It doesn't look like Chicken generates any unnecessary references. ;; So we don't have to remove them either. Nice. @@ -122,6 +133,7 @@ unpacking." (delete 'configure) (delete 'patch-generated-file-shebangs) (add-before 'unpack 'setup-chicken-environment setup-chicken-environment) + (add-before 'build 'stamp-egg-version stamp-egg-version) (replace 'build build) (delete 'check) (replace 'install install) diff --git a/guix/build/dub-build-system.scm b/guix/build/dub-build-system.scm index 3ab50733de..9ee0433ffd 100644 --- a/guix/build/dub-build-system.scm +++ b/guix/build/dub-build-system.scm @@ -48,10 +48,10 @@ (_ #f))) (define* (configure #:key inputs #:allow-other-keys) - "Prepare one new directory with all the required dependencies. - It's necessary to do this (instead of just using /gnu/store as the - directory) because we want to hide the libraries in subdirectories - lib/dub/... instead of polluting the user's profile root." + "Prepare one new directory with all the required dependencies. It's necessary +to do this (instead of just using /gnu/store as the directory) because we want +to hide the libraries in subdirectories lib/dub/... instead of polluting the +user's profile root." (let* ((dir (mkdtemp! "/tmp/dub.XXXXXX")) (vendor-dir (string-append dir "/vendor"))) (setenv "HOME" dir) @@ -67,8 +67,7 @@ (symlink (string-append path "/lib/dub/" d-basename) (string-append vendor-dir "/" d-basename)))))))) inputs) - (invoke "dub" "add-path" vendor-dir) - #t)) + (invoke "dub" "add-path" vendor-dir))) (define (grep string file-name) "Find the first occurrence of STRING in the file named FILE-NAME. @@ -92,19 +91,11 @@ (unless (or (grep* "sourceLibrary" "package.json") (grep* "sourceLibrary" "dub.sdl") ; note: format is different! (grep* "sourceLibrary" "dub.json")) - (apply invoke `("dub" "build" ,@dub-build-flags)) - (substitute* ".dub/dub.json" - (("\"lastUpgrade\": \"[^\"]*\"") - "\"lastUpgrade\": \"1970-01-01T00:00:00.0000000\""))) - #t) + (apply invoke `("dub" "build" ,@dub-build-flags)))) (define* (check #:key tests? #:allow-other-keys) (when tests? - (invoke "dub" "test") - (substitute* ".dub/dub.json" - (("\"lastUpgrade\": \"[^\"]*\"") - "\"lastUpgrade\": \"1970-01-01T00:00:00.0000000\""))) - #t) + (invoke "dub" "test"))) (define* (install #:key inputs outputs #:allow-other-keys) "Install a given DUB package." @@ -115,8 +106,7 @@ ;; TODO remove "-test-application" (copy-recursively "bin" outbin) (mkdir-p outlib) - (copy-recursively "." (string-append outlib)) - #t)) + (copy-recursively "." (string-append outlib)))) (define %standard-phases (modify-phases gnu:%standard-phases diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 4d52200b84..14329751f8 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -81,7 +81,10 @@ (names (map string->symbol (string-tokenize arg not-comma)))) (alist-cons 'updaters names result)))) - (option '(#\L "list-updaters") #f #f + (find (lambda (option) + (member "load-path" (option-names option))) + %standard-build-options) + (option '("list-updaters") #f #f (lambda args (list-updaters-and-exit))) (option '(#\m "manifest") #t #f @@ -119,19 +122,6 @@ (leave (G_ "unsupported policy: ~a~%") arg))))) - ;; The short option -L is already used by --list-updaters, therefore - ;; it needs to be removed from %standard-build-options. - (let ((load-path-option (find (lambda (option) - (member "load-path" - (option-names option))) - %standard-build-options))) - (option - (filter (lambda (name) (not (equal? #\L name))) - (option-names load-path-option)) - (option-required-arg? load-path-option) - (option-optional-arg? load-path-option) - (option-processor load-path-option))) - (option '(#\h "help") #f #f (lambda args (show-help) @@ -160,7 +150,7 @@ specified with `--select'.\n")) -t, --type=UPDATER,... restrict to updates from the specified updaters (e.g., 'gnu')")) (display (G_ " - -L, --list-updaters list available updaters and exit")) + --list-updaters list available updaters and exit")) (display (G_ " -l, --list-dependent list top-level dependent packages that would need to be rebuilt as a result of upgrading PACKAGE...")) @@ -182,7 +172,7 @@ specified with `--select'.\n")) used when 'key-download' is not specified")) (newline) (display (G_ " - --load-path=DIR prepend DIR to the package module search path")) + -L, --load-path=DIR prepend DIR to the package module search path")) (newline) (display (G_ " -h, --help display this help and exit")) diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm index 8123570c38..ca3853af5e 100644 --- a/guix/scripts/style.scm +++ b/guix/scripts/style.scm @@ -303,7 +303,8 @@ FORMAT-COMMENT is 'canonicalize-comment'." (newline port) (display (make-string indent #\space) port)) (let ((column (if newline? indent column))) - (print tail #f + (print tail + (keyword? item) ;keep #:key value next to one another (comment? item) (loop indent column (or newline? delimited?) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index c5f5d23b47..cdf591ac4d 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com> ;;; Copyright © 2020 Christopher Baines <mail@cbaines.net> @@ -55,11 +55,11 @@ #:use-module (ice-9 ftw) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (srfi srfi-71) #:use-module (web uri) #:use-module (guix http-client) #:export (%allow-unauthenticated-substitutes? @@ -293,10 +293,10 @@ daemon." (for-each (cute format port "~a/~a~%" (%store-prefix) <>) (narinfo-references narinfo)) - (let-values (((uri compression file-size) - (narinfo-best-uri narinfo - #:fast-decompression? - %prefer-fast-decompression?))) + (let ((uri compression file-size + (narinfo-best-uri narinfo + #:fast-decompression? + %prefer-fast-decompression?))) (format port "~a\n~a\n" (or file-size 0) (or (narinfo-size narinfo) 0)))) @@ -378,13 +378,13 @@ server certificates." (#f ;; Open a new connection to URI and evict old entries from ;; CACHE, if any. - (let-values (((socket) - (guix:open-connection-for-uri - uri - #:verify-certificate? verify-certificate? - #:timeout timeout)) - ((new-cache evicted) - (at-most (- %max-cached-connections 1) cache))) + (let ((socket + (guix:open-connection-for-uri + uri + #:verify-certificate? verify-certificate? + #:timeout timeout)) + (new-cache evicted + (at-most (- %max-cached-connections 1) cache))) (for-each (match-lambda ((_ . port) (false-if-exception (close-port port)))) @@ -494,49 +494,47 @@ PORT." (leave (G_ "no valid substitute for '~a'~%") store-item)) - (let-values (((uri compression file-size) - (narinfo-best-uri narinfo - #:fast-decompression? - %prefer-fast-decompression?))) + (let ((uri compression file-size + (narinfo-best-uri narinfo + #:fast-decompression? + %prefer-fast-decompression?))) (unless print-build-trace? (format (current-error-port) (G_ "Downloading ~a...~%") (uri->string uri))) - (let*-values (((raw download-size) - ;; 'guix publish' without '--cache' doesn't specify a - ;; Content-Length, so DOWNLOAD-SIZE is #f in this case. - (fetch uri)) - ((progress) - (let* ((dl-size (or download-size - (and (equal? compression "none") - (narinfo-size narinfo)))) - (reporter (if print-build-trace? - (progress-reporter/trace - destination - (uri->string uri) dl-size - (current-error-port)) - (progress-reporter/file - (uri->string uri) dl-size - (current-error-port) - #:abbreviation nar-uri-abbreviation)))) - ;; Keep RAW open upon completion so we can later reuse - ;; the underlying connection. Pass the download size so - ;; that this procedure won't block reading from RAW. - (progress-report-port reporter raw - #:close? #f - #:download-size dl-size))) - ((input pids) - ;; NOTE: This 'progress' port of current process will be - ;; closed here, while the child process doing the - ;; reporting will close it upon exit. - (decompressed-port (string->symbol compression) - progress)) - - ;; Compute the actual nar hash as we read it. - ((algorithm expected) - (narinfo-hash-algorithm+value narinfo)) - ((hashed get-hash) - (open-hash-input-port algorithm input))) + (let* ((raw download-size + ;; 'guix publish' without '--cache' doesn't specify a + ;; Content-Length, so DOWNLOAD-SIZE is #f in this case. + (fetch uri)) + (progress + (let* ((dl-size (or download-size + (and (equal? compression "none") + (narinfo-size narinfo)))) + (reporter (if print-build-trace? + (progress-reporter/trace + destination + (uri->string uri) dl-size + (current-error-port)) + (progress-reporter/file + (uri->string uri) dl-size + (current-error-port) + #:abbreviation nar-uri-abbreviation)))) + ;; Keep RAW open upon completion so we can later reuse + ;; the underlying connection. Pass the download size so + ;; that this procedure won't block reading from RAW. + (progress-report-port reporter raw + #:close? #f + #:download-size dl-size))) + (input pids + ;; NOTE: This 'progress' port of current process will be + ;; closed here, while the child process doing the + ;; reporting will close it upon exit. + (decompressed-port (string->symbol compression) + progress)) + + ;; Compute the actual nar hash as we read it. + (algorithm expected (narinfo-hash-algorithm+value narinfo)) + (hashed get-hash (open-hash-input-port algorithm input))) ;; Unpack the Nar at INPUT into DESTINATION. (define cpu-usage (with-cpu-usage-monitoring diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 63e3b9b934..b9084a401c 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -800,11 +800,6 @@ static checks." (define println (cut format #t "~a~%" <>)) - (define menu-entries - (if (eq? 'init action) - '() - (map boot-parameters->menu-entry (profile-boot-parameters)))) - (define os (image-operating-system image)) @@ -813,7 +808,11 @@ static checks." (define bootcfg (and (memq action '(init reconfigure)) - (operating-system-bootcfg os menu-entries))) + (operating-system-bootcfg + os + (if (eq? action 'init) + '() + (map boot-parameters->menu-entry (profile-boot-parameters)))))) (when (eq? action 'reconfigure) (maybe-suggest-running-guix-pull) diff --git a/guix/self.scm b/guix/self.scm index 36ada4d171..d1ccec8a49 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. @@ -699,7 +699,8 @@ Info manual." (setenv "NIX_STORE_DIR" #$%storedir)) (apply execl #$(file-append daemon "/bin/guix-daemon") - "guix-daemon" (cdr (command-line)))))) + "guix-daemon" (cdr (command-line)))) + #:guile guile)) (computed-file name (with-imported-modules '((guix build utils)) diff --git a/guix/status.scm b/guix/status.scm index b8905c9542..2c69f49fb5 100644 --- a/guix/status.scm +++ b/guix/status.scm @@ -667,13 +667,14 @@ case where BV does not contain only valid UTF-8." (close-port port) str))))) -(define (bytevector-index bv number offset count) - "Search for NUMBER in BV starting from OFFSET and reading up to COUNT bytes; -return the offset where NUMBER first occurs or #f if it could not be found." +(define (bytevector-index bv numbers offset count) + "Search for NUMBERS in BV starting from OFFSET and reading up to COUNT bytes; +return the offset where one of NUMBERS first occurs or #f if they could not be +found." (let loop ((offset offset) (count count)) (cond ((zero? count) #f) - ((= (bytevector-u8-ref bv offset) number) offset) + ((memv (bytevector-u8-ref bv offset) numbers) offset) (else (loop (+ 1 offset) (- count 1)))))) (define (split-lines str) @@ -774,7 +775,12 @@ The second return value is a thunk to retrieve the current state." (set! %build-output '()) (set! %build-output-pid #f)) keep) - (match (bytevector-index bv (char->integer #\newline) + + ;; Search for both '\n' and '\r'; the latter is appears in progress + ;; messages sent by 'guix substitute' through the daemon. + (match (bytevector-index bv + (list (char->integer #\newline) + (char->integer #\return)) offset count) ((? integer? cr) (let* ((tail (maybe-utf8->string diff --git a/guix/utils.scm b/guix/utils.scm index e7a576091e..ca4fecebc8 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -14,6 +14,7 @@ ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; Copyright © 2018 Steve Sprang <scs@stevesprang.com> ;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info> +;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -92,6 +93,7 @@ target-mingw? target-x86-32? target-x86-64? + target-x86? target-arm32? target-aarch64? target-arm? @@ -696,6 +698,10 @@ a character other than '@'." architecture (x86_64)?" (string-prefix? "x86_64-" target)) +(define* (target-x86? #:optional (target (or (%current-target-system) + (%current-system)))) + (or (target-x86-32? target) (target-x86-64? target))) + (define* (target-arm32? #:optional (target (or (%current-target-system) (%current-system)))) (string-prefix? "arm" target)) |