diff options
-rw-r--r-- | guix/build-system/gnu.scm | 9 | ||||
-rw-r--r-- | guix/build/gnu-build-system.scm | 32 |
2 files changed, 39 insertions, 2 deletions
diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index fd9a6d026e..7bdd4174bd 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -50,6 +50,10 @@ (tests? #t) (parallel-build? #t) (parallel-tests? #t) (patch-shebangs? #t) + (strip-binaries? #t) + (strip-flags ''("--strip-debug")) + (strip-directories ''("lib" "lib64" "libexec" + "bin" "sbin")) (phases '%standard-phases) (system (%current-system)) (modules '((guix build gnu-build-system) @@ -73,7 +77,10 @@ input derivation INPUTS, using the usual procedure of the GNU Build System." #:tests? ,tests? #:parallel-build? ,parallel-build? #:parallel-tests? ,parallel-tests? - #:patch-shebangs? ,patch-shebangs?))) + #:patch-shebangs? ,patch-shebangs? + #:strip-binaries? ,strip-binaries? + #:strip-flags ,strip-flags + #:strip-directories ,strip-directories))) (build-expression->derivation store name system builder diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index a1a0f03467..4a83bd0637 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -160,12 +160,42 @@ bindirs) #t)) +(define* (strip #:key outputs (strip-binaries? #t) + (strip-flags '("--strip-debug")) + (strip-directories '("lib" "lib64" "libexec" + "bin" "sbin")) + #:allow-other-keys) + (define (strip-dir dir) + (file-system-fold (const #t) + (lambda (path stat result) ; leaf + (zero? (apply system* "strip" + (append strip-flags (list path))))) + (const #t) ; down + (const #t) ; up + (const #t) ; skip + (lambda (path stat errno result) + (format (current-error-port) + "strip: failed to access `~a': ~a~%" + path (strerror errno)) + #f) + #t + dir)) + + (every strip-dir + (append-map (match-lambda + ((_ . dir) + (filter-map (lambda (d) + (let ((sub (string-append dir "/" d))) + (and (directory-exists? sub) sub))) + strip-directories))) + outputs))) + (define %standard-phases ;; Standard build phases, as a list of symbol/procedure pairs. (let-syntax ((phases (syntax-rules () ((_ p ...) `((p . ,p) ...))))) (phases set-paths unpack patch configure build check install - patch-shebangs))) + patch-shebangs strip))) (define* (gnu-build #:key (source #f) (outputs #f) (inputs #f) |