diff options
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/build-system/gnu.scm | 8 | ||||
| -rw-r--r-- | guix/build/gnu-build-system.scm | 62 |
2 files changed, 69 insertions, 1 deletions
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))) |