[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
07/09: linux-container: don't include /dev/ptmx or /dev/pts from host.
07/09: linux-container: don't include /dev/ptmx or /dev/pts from host.
Wed, 30 Jan 2019 18:34:23 -0500 (EST)
reepca pushed a commit to branch guile-daemon
in repository guix.
Author: Caleb Ristvedt <address@hidden>
Date: Wed Jan 30 17:32:46 2019 -0600
linux-container: don't include /dev/ptmx or /dev/pts from host.
(mount-file-systems): don't include /dev/ptmx or /dev/pts from host. Some
gawk tests get stuck or fail unless a fresh devpts is used, as in the C++
(personality): new procedure.
(ADDR_NO_RANDOMIZE): new variable.
* guix/store/build-derivations.scm: use ADDR_NO_RANDOMIZE and personality.
Output from a builder is now delivered via pipe so that the builder
have access to the terminal directly or something like that.
(remove-from-trie!): Fixed a bug causing strings to get removed from the
trie when they shouldn't be.
(%build-derivation): Put output-spec matching in correct order.
(file-closure): now takes an optional "list-so-far" vlist of
gnu/build/linux-container.scm | 5 +-
guix/build/syscalls.scm | 18 +++-
guix/store/build-derivations.scm | 190 ++++++++++++++++++++++++---------------
3 files changed, 138 insertions(+), 75 deletions(-)
diff --git a/gnu/build/linux-container.scm b/gnu/build/linux-container.scm
index 1dc40d0..8cd0226 100644
@@ -133,9 +133,12 @@ for the process."
+ ; "/dev/ptmx"
+ ;(mkdir (scope "/dev/pts"))
+ ;(bind-mount "/dev/pts" (scope "/dev/pts"))
;; Setup the container's /dev/console by bind mounting the pseudo-terminal
;; associated with standard input when there is one.
(let* ((in (current-input-port))
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 46bca0c..b42f97c 100644
@@ -156,7 +156,9 @@
- (read-utmpx-from-port . read-utmpx)))
+ (read-utmpx-from-port . read-utmpx)
@@ -1956,4 +1958,16 @@ entry."
((? bytevector? bv)
-;;; syscalls.scm ends here
+(define ADDR_NO_RANDOMIZE #x0040000)
+ (let ((proc (syscall->procedure int "personality" `(,unsigned-long))))
+ (lambda (persona)
+ (let-values (((ret err) (proc persona)))
+ (if (= -1 ret)
+ (throw 'system-error "personality" "~A"
+ (list (strerror err))
+ (list err))
+;;; syscalls.scm ends here
diff --git a/guix/store/build-derivations.scm b/guix/store/build-derivations.scm
index 3218711..915298c 100644
@@ -32,6 +32,8 @@
#:use-module (srfi srfi-11)
#:use-module (guix hash)
#:use-module (guix serialization)
+ #:use-module (guix base16)
+ #:use-module (guix sets)
#:use-module ((guix build utils) #:select (delete-file-recursively
@@ -62,20 +64,19 @@
(user build-environment-user) ; the user id to build with.
(group build-environment-group)) ; the group id to build with.
;;; The derivation building process:
;;; 1. Build inputs if necessary.
;;; 2. Make a build directory under TMPDIR or /tmp
-;;; 3. Gather all the inputs, the inputs of the inputs, the inputs of the
-;;; inputs of the inputs, and so on. Copy them to /gnu/store under the build
-;;; 4. Gather all the sources and plop them in the build directory
-;;; 5. Make an output directory for the build under /gnu/store in the build
+;;; 3. Gather all the inputs and sources and anything they transitively
+;;; reference and put them in the store in the chroot directory.
+;;; 4. Make an output directory for the build under /gnu/store in the build
-;;; 6. Set all the environment variables listed in the derivation, some of
+;;; 5. Set all the environment variables listed in the derivation, some of
;;; which we have to honor ourselves, like "preferLocalBuild",
;;; "allowSubstitutes", "allowedReferences", "disallowedReferences", and
-;;; 7. Run the builder in a chroot where the build directory is the root.
+;;; 6. Run the builder in a chroot where the build directory is the root.
;; Add this to (guix config) later
(define %temp-directory "/tmp")
@@ -105,7 +106,6 @@
((@@ (guix scripts perform-download) perform-download) drv)
(get-output-specs drv (all-transitive-inputs drv)))
;; if a derivation builder name is in here, it is a builtin. For normal
;; behavior, make sure everything starts with "builtin:". Also, the procedures
;; stored in here should take a single argument, the derivation.
@@ -161,7 +161,7 @@ environment variable that should be set during the build
("HOME" . "/homeless-shelter")
("NIX_STORE" . ,%store-directory)
;; XXX: make this configurable
- ("NIX_BUILD_CORES" . "1")
+ ("NIX_BUILD_CORES" . "0")
("NIX_BUILD_TOP" . ,in-chroot-build-dir)
;; why yes that is something like /tmp/guix-build-<drv>-0, yes
;; indeed it does not make much sense to make that the TMPDIR
@@ -238,6 +238,8 @@ based on what is in PATHS, which should be a list of paths
or path pairs."
(string= target path)))
(define* (prepare-build-environment drv #:key
@@ -262,9 +264,11 @@ and a list of all the files in the store that could be
- ;; 4. Honor "environment variables" passed through the derivation.
- ;; these include "impureEnvVars", "exportReferencesGraph",
- ;; "build-chroot-dirs", "build-extra-chroot-dirs", "preferLocalBuild"
+ ;; TODO: Honor "environment variables" passed through the derivation.
+ ;; these include "impureEnvVars", "exportReferencesGraph",
+ ;; "allowSubstitutes", "allowedReferences", "disallowedReferences"
+ ;; "preferLocalBuild".
(chown build-dir build-user build-group)
(make-build-environment drv build-dir-inside build-dir env-vars
@@ -272,10 +276,7 @@ and a list of all the files in the store that could be
- (append (match (derivation-outputs drv)
- (((outid . ($ <derivation-output> output-path)) ...)
(define (all-input-output-paths drv)
@@ -301,11 +302,12 @@ provide."
(let ((input-paths (all-input-output-paths drv)))
(vhash-fold (lambda (key val prev)
(cons key prev))
(fold (lambda (input list-so-far)
(file-closure input #:list-so-far list-so-far))
- `(,@(derivation-sources drv)
+ ,@(derivation-sources drv)
;; Sigh... I just HAD to go and ask "what if there are spaces in the mountinfo
@@ -346,17 +348,20 @@ a list of paths or pairs of paths."
;; Indicates CONFIG_DEVPTS_MULTIPLE_INSTANCES=y in the kernel.
- ,@(if (and (file-exists? "/dev/pts/ptmx")
- (not (file-exists? "/dev/ptmx"))
- (not (path-already-assigned? "/dev/pts"
- (list (file-system
- (device "none")
- (mount-point "/dev/pts")
- (type "devpts")
- (options "newinstance,mode=0620")
- (check? #f)))
+ ,@(if (and (file-exists? "/dev/pts/ptmx")
+ ;; This check is fishy
+ (not (path-already-assigned? "/dev/ptmx"
+ (not (path-already-assigned? "/dev/pts"
+ (list (file-system
+ (device "none")
+ (mount-point "/dev/pts")
+ (type "devpts")
+ (options "newinstance,mode=0620")
+ (check? #f)))
;; XXX: Implement this. I couldn't find anything in the manual about ioctl,
@@ -365,13 +370,18 @@ a list of paths or pairs of paths."
+ (let ((current-persona (personality #xffffffff)))
+ (personality (logior current-persona
(define (enact-build-environment build-environment)
"Makes the <build-environment> BUILD-ENVIRONMENT current by setting the
environment variables and bind-mounting the listed files. Importantly, this
assumes that it is in a separate namespace at this point."
;; warning: the order in which a lot of this happens is significant and
;; partially based on guesswork / copying what the c++ does.
;; local communication within the build environment should still be
@@ -386,19 +396,30 @@ assumes that it is in a separate namespace at this point."
(environ (map (match-lambda
((key . val)
(string-append key "=" val)))
- (build-environment-variables build-environment))))
+ (build-environment-variables build-environment)))
+ (sethostname "localhost")
+ (setgid (build-environment-group build-environment))
+ (setuid (build-environment-user build-environment))
+ (chdir (build-directory-inside build-environment)))
;; The C++ stuff does this, and in pursuit of a bug I will mindlessly mimic
- (port-for-each (lambda (port)
- (when (port-filename port)
- (let ((port-fd (port->fdes port)))
- (unless (or
- (= port-fd (port->fdes (current-input-port)))
- (= port-fd (port->fdes (current-output-port)))
- (= port-fd (port->fdes (current-error-port))))
- (close port-fd)))))))
+(define (setup-i/o new-output)
+ "Redirect output and error streams to LOG-PIPE and get input from
+/dev/null, then close all other FDs."
+ (redirect-port new-output (current-output-port))
+ (redirect-port (current-output-port) (current-error-port))
+ (call-with-input-file "/dev/null"
+ (lambda (null-port)
+ (dup2 (port->fdes null-port) 0)))
+ (let close-next ((fd 3))
+ ;; XXX: don't hardcode this.
+ (when (<= fd 20)
+ (false-if-exception (close-fdes fd))
+ (close-next (1+ fd)))))
(define (inputs->mounts inputs)
@@ -418,6 +439,30 @@ assumes that it is in a separate namespace at this point."
+(define (dump-port port)
+ (unless (port-eof? port)
+ (display (get-line port))
+ (display "\n")
+ (dump-port port)))
+(define (open-builder-pipe environment)
+ (let* ((drv (build-environment-derivation environment))
+ (prog (derivation-builder drv))
+ (args (derivation-builder-arguments drv)))
+ (match (pipe)
+ ((read-from . write-to)
+ (match (primitive-fork)
+ (close read-from)
+ (enact-build-environment environment)
+ (setup-i/o write-to)
+ (when (stat "/dev/tty")
+ (format #t "/dev/tty exists!~%"))
+ (apply execl prog (basename prog) args))
+ (close write-to)
+ (values read-from child-pid)))))))
(define (run-builder environment)
"Runs the builder in the environment ENVIRONMENT."
(let ((drv (build-environment-derivation environment)))
@@ -425,23 +470,20 @@ assumes that it is in a separate namespace at this point."
(append (inputs->mounts (build-input-paths environment))
- (enact-build-environment environment)
- ;; DROP PRIVILEGES HERE
- (setgid (build-environment-group environment))
- (setuid (build-environment-user environment))
- (chdir (build-directory-inside environment))
(format #t "command line: ~a~%"
(cons (derivation-builder drv)
- (if (zero? (status:exit-val
- (apply system*
- (derivation-builder drv)
- ;(basename (derivation-builder drv))
- (derivation-builder-arguments drv))))
- (throw 'build-failed-but-lets-debug drv)))
+ (format #t "environment variables: ~a~%" (environ))
+ (let-values (((read-side pid) (open-builder-pipe environment)))
+ (dump-port read-side)
+ (close read-side)
+ (match (status:exit-val (cdr (waitpid pid)))
+ (throw 'build-failed-but-lets-debug exit-val drv)))))
#:namespaces `(mnt pid ipc uts ,@(if (fixed-output-derivation? drv)
@@ -559,9 +601,8 @@ already in TRIE."
(i (1- (bytevector-length sequence))))
((current parent others ...)
- (when (<= (hash-count (const #t)
- (node-table current))
+ (when (zero? (hash-count (const #t)
+ (node-table current)))
(hash-remove! (node-table parent)
(bytevector-u8-ref sequence i))
@@ -574,10 +615,13 @@ already in TRIE."
"Creates a wrapper port which passes through bytes to OUTPUT-PORT and
returns it as well as a procedure which, when called, returns a list of all
references out of the possibilities enumerated in STRINGS that were
+detected. STRINGS must not be empty."
;; Not sure if I should be using custom ports or soft ports...
- (let* ((lookback-size (apply max (map string-length strings)))
- (smallest-length (apply min (map string-length strings)))
+ (let* ((lookback-size (apply max (map (compose bytevector-length
+ (smallest-length (apply min (map (compose bytevector-length
(lookback-buffer (make-bytevector lookback-size))
(search-trie (make-search-trie strings))
@@ -595,22 +639,21 @@ detected."
(define (virtual-ref n)
(if (in-lookback? n)
(bytevector-u8-ref lookback-buffer n)
- (bytevector-u8-ref bytes (- (+ offset n)
+ (bytevector-u8-ref bytes (+ (- n buffer-pos)
(let ((total-length (+ buffer-pos count)))
(define (virtual-copy! start end target)
- (let* ((copy-size (- end start))
- (new-bytevector (make-bytevector copy-size)))
+ (let* ((copy-size (- end start)))
(let copy-next ((i 0))
(unless (= i copy-size)
- (bytevector-u8-set! new-bytevector
+ (bytevector-u8-set! target
(virtual-ref (+ start i)))
(copy-next (1+ i))))
;; the gritty reality of that magic
@@ -626,9 +669,7 @@ detected."
(if (node-string-exists? current-node)
- (format #t "Start:~a End: ~a~%" n i)
- (virtual-copy! n i (make-bytevector (- i n))))
+ (virtual-copy! n i (make-bytevector (- i n)))
(if (>= i total-length)
(let ((next-node (hash-ref (node-table current-node)
@@ -637,7 +678,9 @@ detected."
(test-position (1+ i)
(let next-char ((i 0))
(when (< i (- total-length smallest-length))
@@ -645,13 +688,16 @@ detected."
- (cons (utf8->string match-result)
+ (let ((str-result (utf8->string match-result)))
+ (format #t "Found reference to: ~a~%" str-result)
+ (cons str-result
;; We're not interested in multiple references, it'd
;; just slow us down.
(remove-from-trie! search-trie match-result)
(next-char (+ i (bytevector-length match-result))))
(next-char (1+ i)))))))
+ (format #t "Scanning chunk of ~a bytes~%" count)
(put-bytevector output-port bytes offset count)
- branch guile-daemon created (now e8e41bd), guix-commits, 2019/01/30
- 01/09: patches: honor NIX_STORE in site.py., guix-commits, 2019/01/30
- 04/09: linux-container: new use-output argument., guix-commits, 2019/01/30
- 02/09: guix: store: Make register-items transactional, register drv outputs, guix-commits, 2019/01/30
- 03/09: guix/store/build-derivations.scm: new module., guix-commits, 2019/01/30
- 05/09: build-derivations: use call-with-container, guix-commits, 2019/01/30
- 08/09: build-derivations: Leaked environment variables more robust., guix-commits, 2019/01/30
- 06/09: build-derivations: initial build-group support, guix-commits, 2019/01/30
- 07/09: linux-container: don't include /dev/ptmx or /dev/pts from host.,
- 09/09: gnu: linux-container: Make it more suitable for derivation-building., guix-commits, 2019/01/30