diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | gnu/packages/python.scm | 28 | ||||
| -rw-r--r-- | gnu/packages/samba.scm | 26 | ||||
| -rw-r--r-- | guix/build/rpath.scm | 59 |
4 files changed, 70 insertions, 44 deletions
diff --git a/Makefile.am b/Makefile.am index 00987c7c63..1e440627e1 100644 --- a/Makefile.am +++ b/Makefile.am @@ -58,6 +58,7 @@ MODULES = \ guix/build/perl-build-system.scm \ guix/build/utils.scm \ guix/build/union.scm \ + guix/build/rpath.scm \ guix/packages.scm \ guix/snix.scm \ guix.scm \ diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 23d18909a3..800b08c373 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -66,34 +66,16 @@ #:modules ((guix build gnu-build-system) (guix build utils) - (ice-9 popen) - (ice-9 rdelim) + (guix build rpath) (srfi srfi-26)) + #:imported-modules ((guix build gnu-build-system) + (guix build utils) + (guix build rpath)) #:phases (alist-cons-after 'strip 'add-lib-to-runpath (lambda* (#:key outputs #:allow-other-keys) - ;; XXX: copied from Samba; TODO: factorize in a module - - (define (file-rpath file) - ;; Return the RPATH of FILE. - (let* ((p (open-pipe* OPEN_READ "patchelf" - "--print-rpath" file)) - (l (read-line p))) - (and (zero? (close-pipe p)) l))) - - (define (augment-rpath file dir) - ;; Add DIR to the RPATH of FILE. - (let* ((rpath (file-rpath file)) - (rpath* (if rpath - (string-append dir ":" rpath) - dir))) - (format #t "~a: changing RPATH from `~a' to `~a'~%" - file (or rpath "") rpath*) - (zero? (system* "patchelf" "--set-rpath" - rpath* file)))) - (let* ((out (assoc-ref outputs "out")) (lib (string-append out "/lib"))) ;; Add LIB to the RUNPATH of all the executables. @@ -107,7 +89,7 @@ ("openssl" ,openssl) ("readline" ,readline) ("zlib" ,zlib) - ("patchelf" ,patchelf))) + ("patchelf" ,patchelf))) ; for (guix build rpath) (native-search-paths (list (search-path-specification (variable "PYTHONPATH") diff --git a/gnu/packages/samba.scm b/gnu/packages/samba.scm index 93c9f70a50..b016442908 100644 --- a/gnu/packages/samba.scm +++ b/gnu/packages/samba.scm @@ -111,24 +111,6 @@ anywhere.") (alist-cons-after 'strip 'add-lib-to-runpath (lambda* (#:key outputs #:allow-other-keys) - (define (file-rpath file) - ;; Return the RPATH of FILE. - (let* ((p (open-pipe* OPEN_READ "patchelf" - "--print-rpath" file)) - (l (read-line p))) - (and (zero? (close-pipe p)) l))) - - (define (augment-rpath file dir) - ;; Add DIR to the RPATH of FILE. - (let* ((rpath (file-rpath file)) - (rpath* (if rpath - (string-append dir ":" rpath) - dir))) - (format #t "~a: changing RPATH from `~a' to `~a'~%" - file (or rpath "") rpath*) - (zero? (system* "patchelf" "--set-rpath" - rpath* file)))) - (let* ((out (assoc-ref outputs "out")) (lib (string-append out "/lib"))) ;; Add LIB to the RUNPATH of all the executables. @@ -140,9 +122,11 @@ anywhere.") #:modules ((guix build gnu-build-system) (guix build utils) - (ice-9 popen) - (ice-9 rdelim) + (guix build rpath) (srfi srfi-26)) + #:imported-modules ((guix build gnu-build-system) + (guix build utils) + (guix build rpath)) ;; This flag is required to allow for "make test". #:configure-flags '("--enable-socket-wrapper") @@ -163,7 +147,7 @@ anywhere.") ("openldap" ,openldap) ("linux-pam" ,linux-pam) ("readline" ,readline) - ("patchelf" ,patchelf))) + ("patchelf" ,patchelf))) ; for (guix build rpath) (native-inputs ; for the test suite `(("perl" ,perl) ("python" ,python))) diff --git a/guix/build/rpath.scm b/guix/build/rpath.scm new file mode 100644 index 0000000000..75a1fef5ef --- /dev/null +++ b/guix/build/rpath.scm @@ -0,0 +1,59 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix build rpath) + #:use-module (ice-9 popen) + #:use-module (ice-9 rdelim) + #:export (%patchelf + file-rpath + augment-rpath)) + +;;; Commentary: +;;; +;;; Tools to manipulate the RPATH and RUNPATH of ELF binaries. Currently they +;;; rely on PatchELF. +;;; +;;; Code: + +(define %patchelf + ;; The `patchelf' command. + (make-parameter "patchelf")) + +(define %not-colon + (char-set-complement (char-set #\:))) + +(define (file-rpath file) + "Return the RPATH (or RUNPATH) of FILE as a list of directory names, or #f +on failure." + (let* ((p (open-pipe* OPEN_READ (%patchelf) "--print-rpath" file)) + (l (read-line p))) + (and (zero? (close-pipe p)) + (string-tokenize l %not-colon)))) + +(define (augment-rpath file dir) + "Add DIR to the front of the RPATH and RUNPATH of FILE. Return the new +RPATH as a list, or #f on failure." + (let* ((rpath (or (file-rpath file) '())) + (rpath* (cons dir rpath))) + (format #t "~a: changing RPATH from ~s to ~s~%" + file rpath rpath*) + (and (zero? (system* (%patchelf) "--set-rpath" + (string-join rpath* ":") file)) + rpath*))) + +;;; rpath.scm ends here |