mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
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.
This commit is contained in:
parent
4ba3a84d07
commit
112da58875
3 changed files with 75 additions and 1 deletions
|
@ -393,6 +393,12 @@ (define-public glibc
|
||||||
;; <http://lists.gnu.org/archive/html/guix-devel/2015-02/msg00709.html>.
|
;; <http://lists.gnu.org/archive/html/guix-devel/2015-02/msg00709.html>.
|
||||||
#:parallel-build? #f
|
#: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
|
#:configure-flags
|
||||||
(list "--enable-add-ons"
|
(list "--enable-add-ons"
|
||||||
"--sysconfdir=/etc"
|
"--sysconfdir=/etc"
|
||||||
|
|
|
@ -45,7 +45,9 @@ (define-module (guix build-system gnu)
|
||||||
(define %gnu-build-system-modules
|
(define %gnu-build-system-modules
|
||||||
;; Build-side modules imported and used by default.
|
;; Build-side modules imported and used by default.
|
||||||
'((guix build gnu-build-system)
|
'((guix build gnu-build-system)
|
||||||
(guix build utils)))
|
(guix build utils)
|
||||||
|
(guix build gremlin)
|
||||||
|
(guix elf)))
|
||||||
|
|
||||||
(define %default-modules
|
(define %default-modules
|
||||||
;; Modules in scope in the build-side environment.
|
;; Modules in scope in the build-side environment.
|
||||||
|
@ -283,6 +285,7 @@ (define* (gnu-build store name input-drvs
|
||||||
(strip-flags ''("--strip-debug"))
|
(strip-flags ''("--strip-debug"))
|
||||||
(strip-directories ''("lib" "lib64" "libexec"
|
(strip-directories ''("lib" "lib64" "libexec"
|
||||||
"bin" "sbin"))
|
"bin" "sbin"))
|
||||||
|
(validate-runpath? #t)
|
||||||
(phases '%standard-phases)
|
(phases '%standard-phases)
|
||||||
(locale "en_US.UTF-8")
|
(locale "en_US.UTF-8")
|
||||||
(system (%current-system))
|
(system (%current-system))
|
||||||
|
@ -345,6 +348,7 @@ (define builder
|
||||||
#:parallel-tests? ,parallel-tests?
|
#:parallel-tests? ,parallel-tests?
|
||||||
#:patch-shebangs? ,patch-shebangs?
|
#:patch-shebangs? ,patch-shebangs?
|
||||||
#:strip-binaries? ,strip-binaries?
|
#:strip-binaries? ,strip-binaries?
|
||||||
|
#:validate-runpath? ,validate-runpath?
|
||||||
#:strip-flags ,strip-flags
|
#:strip-flags ,strip-flags
|
||||||
#:strip-directories ,strip-directories)))
|
#:strip-directories ,strip-directories)))
|
||||||
|
|
||||||
|
@ -417,6 +421,7 @@ (define* (gnu-cross-build store name
|
||||||
(strip-flags ''("--strip-debug"))
|
(strip-flags ''("--strip-debug"))
|
||||||
(strip-directories ''("lib" "lib64" "libexec"
|
(strip-directories ''("lib" "lib64" "libexec"
|
||||||
"bin" "sbin"))
|
"bin" "sbin"))
|
||||||
|
(validate-runpath? #t)
|
||||||
(phases '%standard-phases)
|
(phases '%standard-phases)
|
||||||
(locale "en_US.UTF-8")
|
(locale "en_US.UTF-8")
|
||||||
(system (%current-system))
|
(system (%current-system))
|
||||||
|
@ -490,6 +495,7 @@ (define %build-target-inputs
|
||||||
#:parallel-tests? ,parallel-tests?
|
#:parallel-tests? ,parallel-tests?
|
||||||
#:patch-shebangs? ,patch-shebangs?
|
#:patch-shebangs? ,patch-shebangs?
|
||||||
#:strip-binaries? ,strip-binaries?
|
#:strip-binaries? ,strip-binaries?
|
||||||
|
#:validate-runpath? ,validate-runpath?
|
||||||
#:strip-flags ,strip-flags
|
#:strip-flags ,strip-flags
|
||||||
#:strip-directories ,strip-directories))))
|
#:strip-directories ,strip-directories))))
|
||||||
|
|
||||||
|
|
|
@ -18,12 +18,15 @@
|
||||||
|
|
||||||
(define-module (guix build gnu-build-system)
|
(define-module (guix build gnu-build-system)
|
||||||
#:use-module (guix build utils)
|
#:use-module (guix build utils)
|
||||||
|
#:use-module (guix build gremlin)
|
||||||
|
#:use-module (guix elf)
|
||||||
#:use-module (ice-9 ftw)
|
#:use-module (ice-9 ftw)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 regex)
|
#:use-module (ice-9 regex)
|
||||||
#:use-module (ice-9 format)
|
#:use-module (ice-9 format)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
|
#:use-module (rnrs io ports)
|
||||||
#:export (%standard-phases
|
#:export (%standard-phases
|
||||||
gnu-build))
|
gnu-build))
|
||||||
|
|
||||||
|
@ -398,6 +401,64 @@ (define (strip-dir dir)
|
||||||
strip-directories)))
|
strip-directories)))
|
||||||
outputs))))
|
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
|
(define* (validate-documentation-location #:key outputs
|
||||||
#:allow-other-keys)
|
#:allow-other-keys)
|
||||||
"Documentation should go to 'share/info' and 'share/man', not just 'info/'
|
"Documentation should go to 'share/info' and 'share/man', not just 'info/'
|
||||||
|
@ -486,6 +547,7 @@ (define %standard-phases
|
||||||
patch-source-shebangs configure patch-generated-file-shebangs
|
patch-source-shebangs configure patch-generated-file-shebangs
|
||||||
build check install
|
build check install
|
||||||
patch-shebangs strip
|
patch-shebangs strip
|
||||||
|
validate-runpath
|
||||||
validate-documentation-location
|
validate-documentation-location
|
||||||
compress-documentation)))
|
compress-documentation)))
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue