From 9a6ea2f8dc5222018768861a2328e7683e1973c9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 10 Mar 2021 18:49:10 +0100 Subject: syscalls: Define the ST_* constants and add 'statfs-flags->mount-flags'. * guix/build/syscalls.scm (linux?): New variable. (define-statfs-flags): New macro. (ST_RDONLY, ST_NOSUID, ST_NODEV, ST_NOEXEC, ST_SYNCHRONOUS) (ST_MANDLOCK, ST_WRITE, ST_APPEND, ST_IMMUTABLE, ST_NOATIME) (ST_NODIRATIME, ST_RELATIME): New variables. (statfs-flags->mount-flags): New procedure. --- guix/build/syscalls.scm | 67 ++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 66 insertions(+), 1 deletion(-) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 552343a481..6ed11a0d69 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -82,6 +82,21 @@ file-system-fragment-size file-system-mount-flags statfs + + ST_RDONLY + ST_NOSUID + ST_NODEV + ST_NOEXEC + ST_SYNCHRONOUS + ST_MANDLOCK + ST_WRITE + ST_APPEND + ST_IMMUTABLE + ST_NOATIME + ST_NODIRATIME + ST_RELATIME + statfs-flags->mount-flags + free-disk-space device-in-use? add-to-entropy-count @@ -754,6 +769,56 @@ fdatasync(2) on the underlying file descriptor." (define-syntax fsword ;fsword_t (identifier-syntax long)) +(define linux? (string-contains %host-type "linux-gnu")) + +(define-syntax define-statfs-flags + (syntax-rules (linux hurd) + "Define the statfs mount flags." + ((_ (name (linux linux-value) (hurd hurd-value)) rest ...) + (begin + (define name + (if linux? linux-value hurd-value)) + (define-statfs-flags rest ...))) + ((_ (name value) rest ...) + (begin + (define name value) + (define-statfs-flags rest ...))) + ((_) #t))) + +(define-statfs-flags ; + (ST_RDONLY 1) + (ST_NOSUID 2) + (ST_NODEV (linux 4) (hurd 0)) + (ST_NOEXEC 8) + (ST_SYNCHRONOUS 16) + (ST_MANDLOCK (linux 64) (hurd 0)) + (ST_WRITE (linux 128) (hurd 0)) + (ST_APPEND (linux 256) (hurd 0)) + (ST_IMMUTABLE (linux 512) (hurd 0)) + (ST_NOATIME (linux 1024) (hurd 32)) + (ST_NODIRATIME (linux 2048) (hurd 0)) + (ST_RELATIME (linux 4096) (hurd 64))) + +(define (statfs-flags->mount-flags flags) + "Convert FLAGS, a logical or of ST_* constants as returned by +'file-system-mount-flags', to the corresponding logical or of MS_* constants." + (letrec-syntax ((match-flags (syntax-rules (=>) + ((_ (statfs => mount) rest ...) + (logior (if (zero? (logand flags statfs)) + 0 + mount) + (match-flags rest ...))) + ((_) + 0)))) + (match-flags + (ST_RDONLY => MS_RDONLY) + (ST_NOSUID => MS_NOSUID) + (ST_NODEV => MS_NODEV) + (ST_NOEXEC => MS_NOEXEC) + (ST_NOATIME => MS_NOATIME) + (ST_NODIRATIME => 0) ;FIXME + (ST_RELATIME => MS_RELATIME)))) + (define-c-struct %statfs ; sizeof-statfs ;slightly overestimated file-system @@ -769,7 +834,7 @@ fdatasync(2) on the underlying file descriptor." (identifier (array int 2)) (name-length fsword) (fragment-size fsword) - (mount-flags fsword) + (mount-flags fsword) ;ST_* (spare (array fsword 4))) (define statfs -- cgit v1.2.3 From 279d932b1ca7bfbb8657c41a84616dd0dfc6e0a8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 10 Mar 2021 22:51:47 +0100 Subject: download: 'tls-wrap' avoids intermediate buffer. * guix/build/download.scm (tls-wrap)[read!]: Read straight into BV instead of calling 'get-bytevector-some' and 'unget-bytevector'. --- guix/build/download.scm | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) (limited to 'guix/build') diff --git a/guix/build/download.scm b/guix/build/download.scm index 46af149b2f..a027cd4cda 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès ;;; Copyright © 2015 Mark H Weaver ;;; Copyright © 2017 Tobias Geerinckx-Rice ;;; @@ -28,7 +28,6 @@ #:use-module (guix build utils) #:use-module (guix progress) #:use-module (rnrs io ports) - #:use-module ((ice-9 binary-ports) #:select (unget-bytevector)) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) @@ -306,14 +305,10 @@ host name without trailing dot." (let ((record (session-record-port session))) (define (read! bv start count) - (define read-bv (get-bytevector-some record)) - (if (eof-object? read-bv) - 0 ; read! returns 0 on eof-object - (let ((read-bv-len (bytevector-length read-bv))) - (bytevector-copy! read-bv 0 bv start (min read-bv-len count)) - (when (< count read-bv-len) - (unget-bytevector record bv count (- read-bv-len count))) - read-bv-len))) + (let ((read (get-bytevector-n! record bv start count))) + (if (eof-object? read) + 0 + read))) (define (write! bv start count) (put-bytevector record bv start count) (force-output record) -- cgit v1.2.3 From b168acae2a01fd84075cc134a6140594a978fde5 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 10 Mar 2021 23:13:23 +0100 Subject: download: 'tls-wrap' returns an unbuffered custom port. Partly fixes . * guix/build/download.scm (tls-wrap)[unbuffered]: New procedure. Pass the result of 'make-custom-binary-input/output-port' to 'unbuffered'. --- guix/build/download.scm | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) (limited to 'guix/build') diff --git a/guix/build/download.scm b/guix/build/download.scm index a027cd4cda..f24a1e20df 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -323,17 +323,24 @@ host name without trailing dot." (unless (port-closed? record) (close-port record))) + (define (unbuffered port) + (setvbuf port 'none) + port) + (setvbuf record 'block) ;; Return a port that wraps RECORD to ensure that closing it also ;; closes PORT, the actual socket port, and its file descriptor. + ;; Make sure it does not introduce extra buffering (custom ports + ;; are buffered by default as of Guile 3.0.5). ;; XXX: This wrapper would be unnecessary if GnuTLS could ;; automatically close SESSION's file descriptor when RECORD is ;; closed, but that doesn't seem to be possible currently (as of ;; 3.6.9). - (make-custom-binary-input/output-port "gnutls wrapped port" read! write! - get-position set-position! - close)))) + (unbuffered + (make-custom-binary-input/output-port "gnutls wrapped port" read! write! + get-position set-position! + close))))) (define (ensure-uri uri-or-string) ;XXX: copied from (web http) (cond -- cgit v1.2.3 From 4d00185d66c9bd047dfe3077ed89a6a6129429ee Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Tue, 9 Feb 2021 12:04:48 +0200 Subject: build-system/cargo: Propagate crates across builds. * guix/build-system/cargo.scm (cargo-build): Add cargo-package-flags, install-source flags. * guix/build/cargo-build-system.scm (unpack-rust-crates, package): New procedures. (install): Also install crate sources. (%standard-phases): Add new phases. * doc/guix.texi (Packaging-guidelines)[Rust Crates]: Adjust to changes in the cargo-build-system. --- doc/guix.texi | 15 ++++++--- guix/build-system/cargo.scm | 5 +++ guix/build/cargo-build-system.scm | 70 +++++++++++++++++++++++++++++++++++++-- 3 files changed, 82 insertions(+), 8 deletions(-) (limited to 'guix/build') diff --git a/doc/guix.texi b/doc/guix.texi index 4cf241c56a..3e7ffc81bc 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -32,7 +32,7 @@ Copyright @copyright{} 2015, 2016, 2017, 2019, 2020, 2021 Leo Famulari@* Copyright @copyright{} 2015, 2016, 2017, 2018, 2019, 2020 Ricardo Wurmus@* Copyright @copyright{} 2016 Ben Woodcroft@* Copyright @copyright{} 2016, 2017, 2018 Chris Marusich@* -Copyright @copyright{} 2016, 2017, 2018, 2019, 2020 Efraim Flashner@* +Copyright @copyright{} 2016, 2017, 2018, 2019, 2020, 2021 Efraim Flashner@* Copyright @copyright{} 2016 John Darrington@* Copyright @copyright{} 2016, 2017 Nikita Gillmann@* Copyright @copyright{} 2016, 2017, 2018, 2019, 2020 Jan Nieuwenhuizen@* @@ -7449,8 +7449,10 @@ supports builds of packages using Cargo, the build tool of the It adds @code{rustc} and @code{cargo} to the set of inputs. A different Rust package can be specified with the @code{#:rust} parameter. -Regular cargo dependencies should be added to the package definition via the -@code{#:cargo-inputs} parameter as a list of name and spec pairs, where the +Regular cargo dependencies should be added to the package definition similarly +to other packages; those needed only at build time to native-inputs, others to +inputs. If you need to add source-only crates then you should add them to via +the @code{#:cargo-inputs} parameter as a list of name and spec pairs, where the spec can be a package or a source definition. Note that the spec must evaluate to a path to a gzipped tarball which includes a @code{Cargo.toml} file at its root, or it will be ignored. Similarly, cargo dev-dependencies @@ -7461,8 +7463,11 @@ 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. 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 the binaries -defined by the crate. +@code{build} phase. The @code{package} phase will run @code{cargo package} +to create a source crate for future use. The @code{install} phase installs +the binaries defined by the crate. Unless @code{install-source? #f} is +defined it will also install a source crate repository of itself and unpacked +sources, to ease in future hacking on rust packages. @end defvr @defvr {Scheme Variable} chicken-build-system diff --git a/guix/build-system/cargo.scm b/guix/build-system/cargo.scm index 6c8edf6bac..e53d2a7523 100644 --- a/guix/build-system/cargo.scm +++ b/guix/build-system/cargo.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2016 David Craven ;;; Copyright © 2019 Ivan Petkov ;;; Copyright © 2020 Jakub Kądziołka +;;; Copyright © 2021 Efraim Flashner ;;; ;;; This file is part of GNU Guix. ;;; @@ -77,8 +78,10 @@ to NAME and VERSION." (vendor-dir "guix-vendor") (cargo-build-flags ''("--release")) (cargo-test-flags ''("--release")) + (cargo-package-flags ''("--no-metadata" "--no-verify")) (features ''()) (skip-build? #f) + (install-source? #t) (phases '(@ (guix build cargo-build-system) %standard-phases)) (outputs '("out")) @@ -106,8 +109,10 @@ to NAME and VERSION." #:vendor-dir ,vendor-dir #:cargo-build-flags ,cargo-build-flags #:cargo-test-flags ,cargo-test-flags + #:cargo-package-flags ,cargo-package-flags #:features ,features #:skip-build? ,skip-build? + #:install-source? ,install-source? #:tests? ,(and tests? (not skip-build?)) #:phases ,phases #:outputs %outputs diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm index 1d21b33895..c7ca98105c 100644 --- a/guix/build/cargo-build-system.scm +++ b/guix/build/cargo-build-system.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2016 David Craven ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2019 Ivan Petkov -;;; Copyright © 2019, 2020 Efraim Flashner +;;; Copyright © 2019, 2020, 2021 Efraim Flashner ;;; Copyright © 2020 Jakub Kądziołka ;;; Copyright © 2020 Marius Bakke ;;; @@ -73,6 +73,38 @@ Cargo.toml file present at its root." " | cut -d/ -f2" " | grep -q '^Cargo.toml$'"))))) +(define* (unpack-rust-crates #:key inputs vendor-dir #:allow-other-keys) + (define (inputs->rust-inputs inputs) + "Filter using the label part from INPUTS." + (filter (lambda (input) + (match input + ((name . _) (rust-package? name)))) + inputs)) + (define (inputs->directories inputs) + "Extract the directory part from INPUTS." + (match inputs + (((names . directories) ...) + directories))) + + (let ((rust-inputs (inputs->directories (inputs->rust-inputs inputs)))) + (unless (null? rust-inputs) + (mkdir-p "target/package") + (mkdir-p vendor-dir) + ;; TODO: copy only regular inputs to target/package, not native-inputs. + (for-each (lambda (input-crate) + (copy-recursively (string-append input-crate + "/share/cargo/registry") + "target/package")) + (delete-duplicates rust-inputs)) + + (for-each (lambda (crate) + (invoke "tar" "xzf" crate "-C" vendor-dir)) + (find-files "target/package" "\\.crate$")))) + #t) + +(define (rust-package? name) + (string-prefix? "rust-" name)) + (define* (configure #:key inputs (vendor-dir "guix-vendor") #:allow-other-keys) @@ -170,9 +202,27 @@ directory = '" port) (apply invoke "cargo" "test" cargo-test-flags) #t)) -(define* (install #:key inputs outputs skip-build? features #:allow-other-keys) +(define* (package #:key + install-source? + (cargo-package-flags '("--no-metadata" "--no-verify")) + #:allow-other-keys) + "Run 'cargo-package' for a given Cargo package." + (if install-source? + (apply invoke `("cargo" "package" ,@cargo-package-flags)) + (format #t "Not installing cargo sources, skipping `cargo package`.~%")) + #t) + +(define* (install #:key + inputs + outputs + skip-build? + install-source? + features + #:allow-other-keys) "Install a given Cargo package." - (let* ((out (assoc-ref outputs "out"))) + (let* ((out (assoc-ref outputs "out")) + (registry (string-append out "/share/cargo/registry")) + (sources (string-append out "/share/cargo/src"))) (mkdir-p out) ;; Make cargo reuse all the artifacts we just built instead @@ -186,6 +236,18 @@ directory = '" port) (invoke "cargo" "install" "--no-track" "--path" "." "--root" out "--features" (string-join features))) + (when install-source? + ;; Install crate tarballs and unpacked sources for later use. + ;; TODO: Is there a better format/directory for these files? + (mkdir-p sources) + (for-each (lambda (crate) + (install-file crate registry)) + (find-files "target/package" "\\.crate$")) + + (for-each (lambda (crate) + (invoke "tar" "xzf" crate "-C" sources)) + (find-files registry "\\.crate$"))) + #t)) (define %standard-phases @@ -195,6 +257,8 @@ directory = '" port) (replace 'build build) (replace 'check check) (replace 'install install) + (add-after 'build 'package package) + (add-after 'unpack 'unpack-rust-crates unpack-rust-crates) (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 78e7e178a3976d6c38de80449548e0332bbc474c Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Mon, 15 Mar 2021 13:04:46 +0200 Subject: build-system/cargo: Don't clobber packaged crates while building. This fixes an issue where two packages share a common dependent. * guix/build/cargo-build-system.scm (unpack-rust-crates): Only copy rust crates into the target directory if there isn't one already there with the same name. --- guix/build/cargo-build-system.scm | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) (limited to 'guix/build') diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm index c7ca98105c..0a95672b00 100644 --- a/guix/build/cargo-build-system.scm +++ b/guix/build/cargo-build-system.scm @@ -91,11 +91,17 @@ Cargo.toml file present at its root." (mkdir-p "target/package") (mkdir-p vendor-dir) ;; TODO: copy only regular inputs to target/package, not native-inputs. - (for-each (lambda (input-crate) - (copy-recursively (string-append input-crate - "/share/cargo/registry") - "target/package")) - (delete-duplicates rust-inputs)) + (for-each + (lambda (input-crate) + (for-each + (lambda (packaged-crate) + (unless + (file-exists? + (string-append "target/package/" (basename packaged-crate))) + (install-file packaged-crate "target/package/"))) + (find-files + (string-append input-crate "/share/cargo/registry") "\\.crate$"))) + (delete-duplicates rust-inputs)) (for-each (lambda (crate) (invoke "tar" "xzf" crate "-C" vendor-dir)) -- cgit v1.2.3 From 341dfe7eda4972af0a027357015ea595314438b0 Mon Sep 17 00:00:00 2001 From: Chris Marusich Date: Thu, 11 Mar 2021 23:19:30 -0800 Subject: syscalls: mounts: Fix a matching bug. On some systems, the columns in /proc/self/mountinfo look like this: 23 28 0:21 / /proc rw,nosuid,nodev,noexec,relatime shared:11 - proc proc rw Before this change, the mounts procedure was written with the assumption that the type and source could always be found in columns 8 and 9, respectively. However, the proc(5) man page explains that there can be zero or more optional fields starting at column 7 (e.g., "shared:11" above), so this assumption is false in some situations. * guix/build/syscalls.scm (mounts): Update the match pattern to use ellipsis to match zero or more optional fields followed by a single hyphen. Remove the trailing ellipsis, since multiple ellipses are not allowed in the same level. The proc(5) man page indicates that there are no additional columns, so it is probably OK to match an exact number of columns at the end like this. --- guix/build/syscalls.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 6ed11a0d69..4379768f5e 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -636,8 +636,9 @@ current process." (if (eof-object? line) (reverse result) (match (string-tokenize line) + ;; See the proc(5) man page for a description of the columns. ((id parent-id major:minor root mount-point - options _ type source _ ...) + options _ ... "-" type source _) (let ((devno (string->device-number major:minor))) (loop (cons (%mount (octal-decode source) (octal-decode mount-point) -- cgit v1.2.3 From 43937666ba6975b6c847be8e67cecd781ce27049 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 19 Mar 2021 14:23:57 +0100 Subject: download: 'tls-wrap' treats premature TLS termination as EOF. This is a backport of Guile commit 076276c4f580368b4106316a77752d69c8f1494a. * guix/build/download.scm (tls-wrap)[read!]: Wrap 'get-bytevector-n!' call in 'catch' and handle 'error/premature-termination' GnuTLS errors. --- guix/build/download.scm | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) (limited to 'guix/build') diff --git a/guix/build/download.scm b/guix/build/download.scm index f24a1e20df..a22d4064ca 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -305,10 +305,22 @@ host name without trailing dot." (let ((record (session-record-port session))) (define (read! bv start count) - (let ((read (get-bytevector-n! record bv start count))) - (if (eof-object? read) - 0 - read))) + (define read + (catch 'gnutls-error + (lambda () + (get-bytevector-n! record bv start count)) + (lambda (key err proc . rest) + ;; When responding to "Connection: close" requests, some + ;; servers close the connection abruptly after sending the + ;; response body, without doing a proper TLS connection + ;; termination. Treat it as EOF. + (if (eq? err error/premature-termination) + the-eof-object + (apply throw key err proc rest))))) + + (if (eof-object? read) + 0 + read)) (define (write! bv start count) (put-bytevector record bv start count) (force-output record) -- cgit v1.2.3 From b57de27d0331198c9cafb09a1cf8a5fa4f691e36 Mon Sep 17 00:00:00 2001 From: Chris Marusich Date: Sun, 21 Feb 2021 12:17:29 -0800 Subject: syscalls: Fix clone on powerpc64le-linux. This makes the clone procedure work correctly and fixes some test failures on powerpc64le-linux, including tests/containers.scm. * guix/build/syscalls.scm (clone): Add an entry for ppc64le. --- guix/build/syscalls.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 4379768f5e..a2c1d80fb1 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -1021,6 +1021,7 @@ Turning finalization off shuts down the finalization thread as a side effect." ("mips64" 5055) ("armv7l" 120) ("aarch64" 220) + ("ppc64le" 120) (_ #f)))) (lambda (flags) "Create a new child process by duplicating the current parent process. -- cgit v1.2.3 From c29bfbfc78ccd9e5c10d38faf3d269eafed12854 Mon Sep 17 00:00:00 2001 From: Chris Marusich Date: Sun, 21 Feb 2021 16:05:58 -0800 Subject: syscalls: Fix RNDADDTOENTCNT on powerpc64le-linux. This fixes the failing test add-to-entropy-count in tests/syscalls.scm on powerpc64le-linux. * guix/build/syscalls.scm (RNDADDTOENTCNT): When %host-type starts with "powerpc64le", set this to #x80045201. Otherwise, set it to #x40045201 as before. --- guix/build/syscalls.scm | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'guix/build') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index a2c1d80fb1..8886fc0fb9 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -6,6 +6,7 @@ ;;; Copyright © 2019 Guillaume Le Vaillant ;;; Copyright © 2020 Julien Lepiller ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2021 Chris Marusich ;;; ;;; This file is part of GNU Guix. ;;; @@ -942,7 +943,11 @@ backend device." ;;; ;; From . -(define RNDADDTOENTCNT #x40045201) +(define RNDADDTOENTCNT + ;; Avoid using %current-system here to avoid depending on host-side code. + (if (string-prefix? "powerpc64le" %host-type) + #x80045201 + #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 -- cgit v1.2.3