~ruther/guix-local

5d4fd2671aaadc5b0b7e0c331fa5e2a1d7e5c4d8 — Ludovic Courtès 13 years ago 6e32f6c
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.
M Makefile.am => Makefile.am +2 -0
@@ 102,7 102,9 @@ dist_patch_DATA =						\
  distro/packages/patches/cpio-gets-undeclared.patch		\
  distro/packages/patches/diffutils-gets-undeclared.patch	\
  distro/packages/patches/flex-bison-tests.patch		\
  distro/packages/patches/gawk-shell.patch			\
  distro/packages/patches/gettext-gets-undeclared.patch		\
  distro/packages/patches/glibc-bootstrap-system.patch		\
  distro/packages/patches/glibc-no-ld-so-cache.patch		\
  distro/packages/patches/guile-1.8-cpp-4.5.patch		\
  distro/packages/patches/guile-default-utf8.patch		\

M distro/packages/make-bootstrap.scm => distro/packages/make-bootstrap.scm +116 -79
@@ 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.

A distro/packages/patches/gawk-shell.patch => distro/packages/patches/gawk-shell.patch +34 -0
@@ 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__ */


A distro/packages/patches/glibc-bootstrap-system.patch => distro/packages/patches/glibc-bootstrap-system.patch +28 -0
@@ 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);