distro: make-bootstrap: Have libc's functions search for `sh' in $PATH.

* distro/packages/make-bootstrap.scm (%glibc-with-relocatable-system,
  %standard-inputs-with-relocatable-glibc): New variables.
  (%static-inputs)[gawk]: Apply `gawk-shell.patch'.
  [finalize]: New procedure.
  Build all the packages against %STANDARD-INPUTS-WITH-RELOCATABLE-GLIBC.
  (%glibc-stripped): Inherit from %GLIBC-WITH-RELOCATABLE-SYSTEM.
  (%gcc-static, %guile-static): Build against
  %STANDARD-INPUTS-WITH-RELOCATABLE-GLIBC.
* distro/packages/patches/gawk-shell.patch,
  distro/packages/patches/glibc-bootstrap-system.patch: New files.
* Makefile.am (dist_patch_DATA): Add them.

3 files changed, 178 insertions, 79 deletions

diff --git a/distro/packages/make-bootstrap.scm b/distro/packages/make-bootstrap.scm
index bbed4a6e1d..4f182da853 100644
--- a/distro/packages/make-bootstrap.scm
+++ b/distro/packages/make-bootstrap.scm
@@ -20,6 +20,7 @@
   #:use-module (guix utils)
   #:use-module (guix packages)
   #:use-module (guix build-system trivial)
+  #:use-module ((guix build-system gnu) #:select (package-with-explicit-inputs))
   #:use-module ((distro) #:select (search-patch))
   #:use-module (distro packages base)
   #:use-module (distro packages bash)
@@ -29,6 +30,7 @@
   #:use-module (distro packages linux)
   #:use-module (distro packages multiprecision)
   #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
   #:export (%bootstrap-binaries-tarball
             %binutils-bootstrap-tarball
             %glibc-bootstrap-tarball
@@ -66,6 +68,29 @@
                (augment (apply args x)))
              (augment args)))))))
 
+(define %glibc-with-relocatable-system
+  ;; A libc whose `system' and `popen' functions looks for `sh' in $PATH.
+  (package (inherit glibc-final)
+    (arguments
+     (lambda (system)
+       (substitute-keyword-arguments ((package-arguments glibc-final) system)
+         ((#:patches patches)
+          `(cons (assoc-ref %build-inputs "patch/system")
+                 ,patches)))))
+    (inputs
+     `(("patch/system" ,(search-patch "glibc-bootstrap-system.patch"))
+       ,@(package-inputs glibc-final)))))
+
+(define %standard-inputs-with-relocatable-glibc
+  ;; Standard inputs with the above libc and corresponding GCC.
+  `(("libc", %glibc-with-relocatable-system)
+    ("gcc" ,(package-with-explicit-inputs
+             gcc-4.7
+             `(("libc",%glibc-with-relocatable-system)
+               ,@(alist-delete "libc" %final-inputs))
+             (current-source-location)))
+    ,@(fold alist-delete %final-inputs '("libc" "gcc"))))
+
 (define %bash-static
   (let ((bash-light (package (inherit bash-final)
                       (inputs '())              ; no readline, no curses
@@ -121,7 +146,8 @@
         (gawk (package (inherit gawk)
                 (arguments
                  (lambda (system)
-                   `(#:phases (alist-cons-before
+                   `(#:patches (list (assoc-ref %build-inputs "patch/sh"))
+                     #:phases (alist-cons-before
                                'build 'no-export-dynamic
                                (lambda* (#:key outputs #:allow-other-keys)
                                  ;; Since we use `-static', remove
@@ -129,10 +155,16 @@
                                  (substitute* "configure"
                                    (("-export-dynamic") "")))
                                %standard-phases)
-                     ,@((package-arguments gawk) system)))))))
+                     ,@((package-arguments gawk) system))))
+                (inputs `(("patch/sh" ,(search-patch "gawk-shell.patch"))))))
+        (finalize (lambda (p)
+                    (static-package (package-with-explicit-inputs
+                                     p
+                                     %standard-inputs-with-relocatable-glibc)
+                                    (current-source-location)))))
     `(,@(map (match-lambda
               ((name package)
-               (list name (static-package package (current-source-location)))))
+               (list name (finalize package))))
              `(("tar" ,tar)
                ("gzip" ,gzip)
                ("bzip2" ,bzip2)
@@ -272,84 +304,87 @@
   ;; 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.
-  (package (inherit glibc-final)
-    (name "glibc-stripped")
-    (build-system trivial-build-system)
-    (arguments
-     `(#:modules ((guix build utils))
-       #: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" ,glibc-final)
-              ("linux-headers" ,linux-libre-headers)))))
+  (let ((glibc %glibc-with-relocatable-system))
+    (package (inherit glibc)
+      (name "glibc-stripped")
+      (build-system trivial-build-system)
+      (arguments
+       `(#:modules ((guix build utils))
+         #: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" ,glibc)
+                ("linux-headers" ,linux-libre-headers))))))
 
 (define %gcc-static
   ;; A statically-linked GCC, with stripped-down functionality.
-  (package (inherit gcc-final)
-    (name "gcc-static")
-    (arguments
-     (lambda (system)
-       `(#:modules ((guix build utils)
-                    (guix build gnu-build-system)
-                    (srfi srfi-1)
-                    (srfi srfi-26)
-                    (ice-9 regex))
-         ,@(substitute-keyword-arguments ((package-arguments gcc-final) system)
-             ((#:guile _) #f)
-             ((#:implicit-inputs? _) #t)
-             ((#:configure-flags flags)
-              `(append (list
-                        "--disable-shared"
-                        "--disable-plugin"
-                        "--enable-languages=c"
-                        "--disable-libmudflap"
-                        "--disable-libgomp"
-                        "--disable-libssp"
-                        "--disable-libquadmath"
-                        "--disable-decimal-float")
-                       (remove (cut string-match "--(.*plugin|enable-languages)" <>)
-                               ,flags)))
-             ((#:make-flags flags)
-              `(cons "BOOT_LDFLAGS=-static" ,flags))))))
-    (inputs `(("gmp-source" ,(package-source gmp))
-              ("mpfr-source" ,(package-source mpfr))
-              ("mpc-source" ,(package-source mpc))
-              ("binutils" ,binutils-final)
-              ,@(package-inputs gcc-4.7)))))
+  (package-with-explicit-inputs
+   (package (inherit gcc-final)
+     (name "gcc-static")
+     (arguments
+      (lambda (system)
+        `(#:modules ((guix build utils)
+                     (guix build gnu-build-system)
+                     (srfi srfi-1)
+                     (srfi srfi-26)
+                     (ice-9 regex))
+          ,@(substitute-keyword-arguments ((package-arguments gcc-final) system)
+              ((#:guile _) #f)
+              ((#:implicit-inputs? _) #t)
+              ((#:configure-flags flags)
+               `(append (list
+                         "--disable-shared"
+                         "--disable-plugin"
+                         "--enable-languages=c"
+                         "--disable-libmudflap"
+                         "--disable-libgomp"
+                         "--disable-libssp"
+                         "--disable-libquadmath"
+                         "--disable-decimal-float")
+                        (remove (cut string-match "--(.*plugin|enable-languages)" <>)
+                                ,flags)))
+              ((#:make-flags flags)
+               `(cons "BOOT_LDFLAGS=-static" ,flags))))))
+     (inputs `(("gmp-source" ,(package-source gmp))
+               ("mpfr-source" ,(package-source mpfr))
+               ("mpc-source" ,(package-source mpc))
+               ("binutils" ,binutils-final)
+               ,@(package-inputs gcc-4.7))))
+   %standard-inputs-with-relocatable-glibc))
 
 (define %gcc-stripped
   ;; The subset of GCC files needed for bootstrap.
@@ -429,7 +464,9 @@
                     ;; There are uses of `dynamic-link' in
                     ;; {foreign,coverage}.test that don't fly here.
                     #:tests? #f)))))
-    (static-package guile (current-source-location))))
+    (package-with-explicit-inputs (static-package guile)
+                                  %standard-inputs-with-relocatable-glibc
+                                  (current-source-location))))
 
 (define %guile-static-stripped
   ;; A stripped static Guile binary, for use during bootstrap.
diff --git a/distro/packages/patches/gawk-shell.patch b/distro/packages/patches/gawk-shell.patch
new file mode 100644
index 0000000000..89b8540a8d
--- /dev/null
+++ b/distro/packages/patches/gawk-shell.patch
@@ -0,0 +1,34 @@
+As for libc's `system', change Awk to look for `sh' in $PATH.  This patch is
+only meant to be used during bootstrapping, where we don't know in advance the
+absolute file name of `sh'.
+
+--- gawk-4.0.0/io.c	2011-05-18 20:47:29.000000000 +0200
++++ gawk-4.0.0/io.c	2012-12-18 15:56:06.000000000 +0100
+@@ -1759,7 +1759,7 @@ two_way_open(const char *str, struct red
+ 
+ 			signal(SIGPIPE, SIG_DFL);
+ 
+-			execl("/bin/sh", "sh", "-c", str, NULL);
++			execlp("sh", "sh", "-c", str, NULL);
+ 			_exit(errno == ENOENT ? 127 : 126);
+ 
+ 		case -1:
+@@ -1924,7 +1924,7 @@ use_pipes:
+ 		    || close(ctop[0]) == -1 || close(ctop[1]) == -1)
+ 			fatal(_("close of pipe failed (%s)"), strerror(errno));
+ 		/* stderr does NOT get dup'ed onto child's stdout */
+-		execl("/bin/sh", "sh", "-c", str, NULL);
++		execlp("sh", "sh", "-c", str, NULL);
+ 		_exit(errno == ENOENT ? 127 : 126);
+ 	}
+ #endif /* NOT __EMX__ */
+@@ -2074,7 +2074,7 @@ gawk_popen(const char *cmd, struct redir
+ 			fatal(_("moving pipe to stdout in child failed (dup: %s)"), strerror(errno));
+ 		if (close(p[0]) == -1 || close(p[1]) == -1)
+ 			fatal(_("close of pipe failed (%s)"), strerror(errno));
+-		execl("/bin/sh", "sh", "-c", cmd, NULL);
++		execlp("sh", "sh", "-c", cmd, NULL);
+ 		_exit(errno == ENOENT ? 127 : 126);
+ 	}
+ #endif /* NOT __EMX__ */
+
diff --git a/distro/packages/patches/glibc-bootstrap-system.patch b/distro/packages/patches/glibc-bootstrap-system.patch
new file mode 100644
index 0000000000..7208cce3f4
--- /dev/null
+++ b/distro/packages/patches/glibc-bootstrap-system.patch
@@ -0,0 +1,28 @@
+We want to allow builds in chroots that lack /bin/sh.  Thus, system(3)
+and popen(3) need to be tweaked to use the right shell.  For the bootstrap
+glibc, we just use whatever `sh' can be found in $PATH.  The final glibc
+instead uses the hard-coded absolute file name of `bash'.
+
+--- a/sysdeps/posix/system.c
++++ b/sysdeps/posix/system.c
+@@ -134,7 +134,7 @@ do_system (const char *line)
+       INIT_LOCK ();
+ 
+       /* Exec the shell.  */
+-      (void) __execve (SHELL_PATH, (char *const *) new_argv, __environ);
++      (void) __execvpe (SHELL_NAME, (char *const *) new_argv, __environ);
+       _exit (127);
+     }
+   else if (pid < (pid_t) 0)
+
+--- b/libio/iopopen.c	2012-06-30 21:12:34.000000000 +0200
++++ b/libio/iopopen.c	2012-12-19 12:52:29.000000000 +0100
+@@ -226,7 +226,7 @@ _IO_new_proc_open (fp, command, mode)
+ 	    _IO_close (fd);
+ 	}
+ 
+-      _IO_execl ("/bin/sh", "sh", "-c", command, (char *) 0);
++      execlp ("sh", "sh", "-c", command, (char *) 0);
+       _IO__exit (127);
+     }
+   _IO_close (child_end);