summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/packages/base.scm6
-rw-r--r--guix/build-system/gnu.scm8
-rw-r--r--guix/build/gnu-build-system.scm62
3 files changed, 75 insertions, 1 deletions
diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm
index 3ed853a179..3ff3172f0f 100644
--- a/gnu/packages/base.scm
+++ b/gnu/packages/base.scm
@@ -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"
diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index e4cbd29395..3ccdef1328 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -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))))
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index 5ae537150f..5220bda71f 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -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)))