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
parent
4ba3a84d07
commit
112da58875
|
@ -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"
|
||||
|
|
|
@ -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))))
|
||||
|
||||
|
|
|
@ -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)))
|
||||
|
||||
|
|
Reference in New Issue