11/17: gnu: make-bootstrap: Produce the correct %glibc-bootstrap-tarball for Hurd systems.

[Manolis Fragkiskos Ragkousis]

phant0mas pushed a commit to branch wip-hurd
in repository guix.

commit fcb727b79b0821cd27146dfef7bcf75330622fdf
Author: Manolis Ragkousis <address@hidden>
Date:   Sat Jul 18 18:41:19 2015 +0300

    gnu: make-bootstrap: Produce the correct %glibc-bootstrap-tarball for Hurd 
systems.
    
    * gnu/packages/make-bootstrap.scm (%glibc-bootstrap-tarball): Make it a 
procedure.
      (%glibc-stripped): Make it a procedure and move the kernel specific part 
from
      here to ...
    * guix/build/make-bootstrap.scm (make-stripped-libc): ... here. New file.
    * Makefile.am (MODULES): Add it.
---
 Makefile.am                     |    1 +
 gnu/packages/make-bootstrap.scm |   67 +++++++++++--------------------
 guix/build/make-bootstrap.scm   |   84 +++++++++++++++++++++++++++++++++++++++
 3 files changed, 108 insertions(+), 44 deletions(-)

diff --git a/Makefile.am b/Makefile.am
index a8dab5d..8db0f78 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -93,6 +93,7 @@ MODULES =                                     \
   guix/build/gremlin.scm                       \
   guix/build/emacs-utils.scm                   \
   guix/build/graft.scm                         \
+  guix/build/make-bootstrap.scm                        \
   guix/search-paths.scm                                \
   guix/packages.scm                            \
   guix/import/utils.scm                                \
diff --git a/gnu/packages/make-bootstrap.scm b/gnu/packages/make-bootstrap.scm
index b3c86db..e4af255 100644
--- a/gnu/packages/make-bootstrap.scm
+++ b/gnu/packages/make-bootstrap.scm
@@ -33,6 +33,7 @@
   #:use-module (gnu packages guile)
   #:use-module (gnu packages bdw-gc)
   #:use-module (gnu packages linux)
+  #:use-module (gnu packages hurd)
   #:use-module (gnu packages multiprecision)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
@@ -325,61 +326,39 @@ for `sh' in $PATH, and without nscd, and with static NSS 
modules."
            #t))))
     (inputs `(("binutils" ,%binutils-static)))))
 
-(define %glibc-stripped
+(define (%glibc-stripped)
   ;; GNU libc's essential shared libraries, dynamic linker, and headers,
   ;; with all references to store directories stripped.  As a result,
   ;; libc.so is unusable and need to be patched for proper relocation.
+  (define (hurd-triplet? triplet)
+    (and (string-suffix? "-gnu" triplet)
+         (not (string-contains triplet "linux"))))
+
   (let ((glibc (glibc-for-bootstrap)))
     (package (inherit glibc)
       (name "glibc-stripped")
       (build-system trivial-build-system)
       (arguments
-       `(#:modules ((guix build utils))
+       `(#:modules ((guix build utils)
+                    (guix build make-bootstrap))
          #:builder
          (begin
-           (use-modules (guix build utils))
-
-           (setvbuf (current-output-port) _IOLBF)
-           (let* ((out    (assoc-ref %outputs "out"))
-                  (libdir (string-append out "/lib"))
-                  (incdir (string-append out "/include"))
-                  (libc   (assoc-ref %build-inputs "libc"))
-                  (linux  (assoc-ref %build-inputs "linux-headers")))
-             (mkdir-p libdir)
-             (for-each (lambda (file)
-                         (let ((target (string-append libdir "/"
-                                                      (basename file))))
-                           (copy-file file target)
-                           (remove-store-references target)))
-                       (find-files (string-append libc "/lib")
-                                   
"^(crt.*|ld.*|lib(c|m|dl|rt|pthread|nsl|util).*\\.so(\\..*)?|libc_nonshared\\.a)$"))
-
-             (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)
-                         (copy-file (string-append linux "/include/linux/" 
file)
-                                    (string-append incdir "/linux/"
-                                                   (basename file))))
-                       '("limits.h" "errno.h" "socket.h" "kernel.h"
-                         "sysctl.h" "param.h" "ioctl.h" "types.h"
-                         "posix_types.h" "stddef.h"))
-
-             (copy-recursively (string-append linux "/include/asm")
-                               (string-append incdir "/asm"))
-             (copy-recursively (string-append linux "/include/asm-generic")
-                               (string-append incdir "/asm-generic"))
-
-             #t))))
-      (inputs `(("libc" ,(let ((target (%current-target-system)))
+           (use-modules (guix build make-bootstrap))
+           (make-stripped-libc (assoc-ref %outputs "out")
+                               (assoc-ref %build-inputs "libc")
+                               (assoc-ref %build-inputs "kernel-headers")))))
+      (inputs `(("kernel-headers"
+                 ,(if (or (and (%current-target-system)
+                               (hurd-triplet? (%current-target-system)))
+                          (string-suffix? "-hurd" (%current-system)))
+                      gnumach-headers
+                      linux-libre-headers))
+                ("libc" ,(let ((target (%current-target-system)))
                            (if target
                                (glibc-for-bootstrap
                                 (parameterize ((%current-target-system #f))
                                   (cross-libc target)))
-                               glibc)))
-                ("linux-headers" ,linux-libre-headers)))
+                               glibc)))))
 
       ;; Only one output.
       (outputs '("out")))))
@@ -639,9 +618,9 @@ for `sh' in $PATH, and without nscd, and with static NSS 
modules."
   ;; A tarball with the statically-linked Binutils programs.
   (tarball-package %binutils-static-stripped))
 
-(define %glibc-bootstrap-tarball
+(define (%glibc-bootstrap-tarball)
   ;; A tarball with GNU libc's shared libraries, dynamic linker, and headers.
-  (tarball-package %glibc-stripped))
+  (tarball-package (%glibc-stripped)))
 
 (define %gcc-bootstrap-tarball
   ;; A tarball with a dynamic-linked GCC and its headers.
@@ -681,7 +660,7 @@ for `sh' in $PATH, and without nscd, and with static NSS 
modules."
     (inputs `(("guile-tarball" ,%guile-bootstrap-tarball)
               ("gcc-tarball" ,%gcc-bootstrap-tarball)
               ("binutils-tarball" ,%binutils-bootstrap-tarball)
-              ("glibc-tarball" ,%glibc-bootstrap-tarball)
+              ("glibc-tarball" ,(%glibc-bootstrap-tarball))
               ("coreutils&co-tarball" ,%bootstrap-binaries-tarball)))
     (synopsis #f)
     (description #f)
diff --git a/guix/build/make-bootstrap.scm b/guix/build/make-bootstrap.scm
new file mode 100644
index 0000000..283a13e
--- /dev/null
+++ b/guix/build/make-bootstrap.scm
@@ -0,0 +1,84 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 Manolis Fragkiskos Ragkousis <address@hidden>
+;;; Copyright © 2015 Ludovic Courtès <address@hidden>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(define-module (guix build make-bootstrap)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-26)
+  #:use-module (guix build utils)
+  #:export (make-stripped-libc))
+
+;; Commentary:
+;;
+;; This module provides facilities to build the bootstrap binaries.
+;;
+;; Code:
+
+(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."
+
+  (define (copy-mach-headers output kernel-headers)
+    (let* ((incdir (string-append output "/include")))
+      (copy-recursively (string-append libc "/include") incdir)
+
+      (copy-recursively (string-append kernel-headers "/include/mach")
+                        (string-append incdir "/mach"))
+      #t))
+  
+  (define (copy-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)
+                  (copy-file (string-append kernel-headers "/include/linux/" 
file)
+                             (string-append incdir "/linux/"
+                                            (basename file))))
+                '("limits.h" "errno.h" "socket.h" "kernel.h"
+                  "sysctl.h" "param.h" "ioctl.h" "types.h"
+                  "posix_types.h" "stddef.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))
+
+  (setvbuf (current-output-port) _IOLBF)
+  (let* ((libdir (string-append output "/lib")))
+    (mkdir-p libdir)
+    (for-each (lambda (file)
+                (let ((target (string-append libdir "/"
+                                             (basename file))))
+                  (copy-file file target)
+                  (remove-store-references target)))
+              (find-files (string-append libc "/lib")
+                          
"^(crt.*|ld.*|lib(c|m|dl|rt|pthread|nsl|util).*\\.so(\\..*)?|\
+lib(machuser|hurduser).so.*|libc(rt|)_nonshared\\.a)$"))
+    #t)
+
+    (if (directory-exists? (string-append kernel-headers "/include/mach"))
+        (copy-mach-headers output kernel-headers)
+        (copy-linux-headers output kernel-headers)))
+
+