diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index 2fa3506c54..ec43e2144c 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -362,6 +362,7 @@ (define* (gnu-build name inputs (license-file-regexp %license-file-regexp) (phases '%standard-phases) (locale "C.UTF-8") + (separate-from-pid1? #t) (system (%current-system)) (build (nix-system->gnu-triplet system)) (imported-modules %default-gnu-imported-modules) @@ -404,6 +405,7 @@ (define builder (sexp->gexp phases) phases) #:locale #$locale + #:separate-from-pid1? #$separate-from-pid1? #:bootstrap-scripts #$bootstrap-scripts #:configure-flags #$(if (pair? configure-flags) (sexp->gexp configure-flags) @@ -505,6 +507,7 @@ (define* (gnu-cross-build name (license-file-regexp %license-file-regexp) (phases '%standard-phases) (locale "C.UTF-8") + (separate-from-pid1? #t) (system (%current-system)) (build (nix-system->gnu-triplet system)) (imported-modules %default-gnu-imported-modules) @@ -550,6 +553,7 @@ (define %outputs (sexp->gexp phases) phases) #:locale #$locale + #:separate-from-pid1? #$separate-from-pid1? #:bootstrap-scripts #$bootstrap-scripts #:configure-flags #$configure-flags #:make-flags #$make-flags diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 39707e7ace..51b8f9acbf 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -72,6 +72,42 @@ (define (first-subdirectory directory) ((first . _) first) (_ #f))) +(define* (separate-from-pid1 #:key (separate-from-pid1? #t) + #:allow-other-keys) + "When running as PID 1 and SEPARATE-FROM-PID1? is true, run build phases as +a child process; PID 1 then becomes responsible for reaping child processes." + (if separate-from-pid1? + (if (= 1 (getpid)) + (dynamic-wind + (const #t) + (lambda () + (match (primitive-fork) + (0 #t) + (builder-pid + (format (current-error-port) + "build process now running as PID ~a~%" + builder-pid) + (let loop () + ;; Running as PID 1 so take responsibility for reaping + ;; child processes. + (match (waitpid WAIT_ANY) + ((pid . status) + (if (= pid builder-pid) + (if (zero? status) + (primitive-exit 0) + (begin + (format (current-error-port) + "build process ~a exited with status ~a~%" + pid status) + (primitive-exit 1))) + (loop)))))))) + (const #t)) + (format (current-error-port) "not running as PID 1 (PID: ~a)~%" + (getpid))) + (format (current-error-port) + "build process running as PID ~a; not forking~%" + (getpid)))) + (define* (set-paths #:key target inputs native-inputs (search-paths '()) (native-search-paths '()) #:allow-other-keys) @@ -872,7 +908,8 @@ (define %standard-phases ;; Standard build phases, as a list of symbol/procedure pairs. (let-syntax ((phases (syntax-rules () ((_ p ...) `((p . ,p) ...))))) - (phases set-SOURCE-DATE-EPOCH set-paths install-locale unpack + (phases separate-from-pid1 + set-SOURCE-DATE-EPOCH set-paths install-locale unpack bootstrap patch-usr-bin-file patch-source-shebangs configure patch-generated-file-shebangs