build-system/gnu: Add 'validate-runpath' phase.

* guix/build/gnu-build-system.scm (every*, validate-runpath): New
  procedures.
  (%standard-phases): Add 'validate-runpath'.
* guix/build-system/gnu.scm (%gnu-build-system-modules): Add (guix build
  gremlin) and (guix elf).
  (gnu-build): Add #:validate-runpath?.
  [builder]: Pass it.
  (gnu-cross-build): Likewise.
* gnu/packages/base.scm (glibc)[arguments]: Add #:validate-runpath? #f.
master
Ludovic Courtès 2015-04-01 16:47:49 +02:00
parent 4ba3a84d07
commit 112da58875
3 changed files with 75 additions and 1 deletions

View File

@ -393,6 +393,12 @@ included.")
;; <http://lists.gnu.org/archive/html/guix-devel/2015-02/msg00709.html>.
#:parallel-build? #f
;; The libraries have an empty RUNPATH, but some, such as the versioned
;; libraries (libdl-2.21.so, etc.) have ld.so marked as NEEDED. Since
;; these libraries are always going to be found anyway, just skip
;; RUNPATH checks.
#:validate-runpath? #f
#:configure-flags
(list "--enable-add-ons"
"--sysconfdir=/etc"

View File

@ -45,7 +45,9 @@
(define %gnu-build-system-modules
;; Build-side modules imported and used by default.
'((guix build gnu-build-system)
(guix build utils)))
(guix build utils)
(guix build gremlin)
(guix elf)))
(define %default-modules
;; Modules in scope in the build-side environment.
@ -283,6 +285,7 @@ standard packages used as implicit inputs of the GNU build system."
(strip-flags ''("--strip-debug"))
(strip-directories ''("lib" "lib64" "libexec"
"bin" "sbin"))
(validate-runpath? #t)
(phases '%standard-phases)
(locale "en_US.UTF-8")
(system (%current-system))
@ -345,6 +348,7 @@ are allowed to refer to."
#:parallel-tests? ,parallel-tests?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:validate-runpath? ,validate-runpath?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories)))
@ -417,6 +421,7 @@ is one of `host' or `target'."
(strip-flags ''("--strip-debug"))
(strip-directories ''("lib" "lib64" "libexec"
"bin" "sbin"))
(validate-runpath? #t)
(phases '%standard-phases)
(locale "en_US.UTF-8")
(system (%current-system))
@ -490,6 +495,7 @@ platform."
#:parallel-tests? ,parallel-tests?
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:validate-runpath? ,validate-runpath?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories))))

View File

@ -18,12 +18,15 @@
(define-module (guix build gnu-build-system)
#:use-module (guix build utils)
#:use-module (guix build gremlin)
#:use-module (guix elf)
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 format)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (rnrs io ports)
#:export (%standard-phases
gnu-build))
@ -398,6 +401,64 @@ makefiles."
strip-directories)))
outputs))))
(define (every* pred lst)
"This is like 'every', but process all the elements of LST instead of
stopping as soon as PRED returns false. This is useful when PRED has side
effects, such as displaying warnings or error messages."
(let loop ((lst lst)
(result #t))
(match lst
(()
result)
((head . tail)
(loop tail (and (pred head) result))))))
(define* (validate-runpath #:key
validate-runpath?
(elf-directories '("lib" "lib64" "libexec"
"bin" "sbin"))
outputs #:allow-other-keys)
"When VALIDATE-RUNPATH? is true, validate that all the ELF files in
ELF-DIRECTORIES have their dependencies found in their 'RUNPATH'.
Since the ELF parser needs to have a copy of files in memory, better run this
phase after stripping."
(define (sub-directory parent)
(lambda (directory)
(let ((directory (string-append parent "/" directory)))
(and (directory-exists? directory) directory))))
(define (validate directory)
(define (file=? file1 file2)
(let ((st1 (stat file1))
(st2 (stat file2)))
(= (stat:ino st1) (stat:ino st2))))
;; There are always symlinks from '.so' to '.so.1' and so on, so delete
;; duplicates.
(let ((files (delete-duplicates (find-files directory (lambda (file stat)
(elf-file? file)))
file=?)))
(format (current-error-port)
"validating RUNPATH of ~a binaries in ~s...~%"
(length files) directory)
(every* validate-needed-in-runpath files)))
(if validate-runpath?
(let ((dirs (append-map (match-lambda
(("debug" . _)
;; The "debug" output is full of ELF files
;; that are not worth checking.
'())
((name . output)
(filter-map (sub-directory output)
elf-directories)))
outputs)))
(every* validate dirs))
(begin
(format (current-error-port) "skipping RUNPATH validation~%")
#t)))
(define* (validate-documentation-location #:key outputs
#:allow-other-keys)
"Documentation should go to 'share/info' and 'share/man', not just 'info/'
@ -486,6 +547,7 @@ DOCUMENTATION-COMPRESSOR-FLAGS."
patch-source-shebangs configure patch-generated-file-shebangs
build check install
patch-shebangs strip
validate-runpath
validate-documentation-location
compress-documentation)))