aboutsummaryrefslogtreecommitdiff
path: root/guix/build
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-04-01 14:02:49 +0200
committerLudovic Courtès <ludo@gnu.org>2015-04-01 14:17:39 +0200
commit7be8c63e0de635f8c669dc19d7ac1d3cdbe28894 (patch)
tree4de659503edd1df1b3cb5165d8d82ccdfd82513a /guix/build
parentd83ccc9b428fededaa6ec29a0df7b2728ad734f3 (diff)
downloadgnu-guix-7be8c63e0de635f8c669dc19d7ac1d3cdbe28894.tar
gnu-guix-7be8c63e0de635f8c669dc19d7ac1d3cdbe28894.tar.gz
gremlin: Guard against invalid ELF segments.
* guix/build/gremlin.scm (&elf-error, &invalid-segment-size): New error condition types. (dynamic-link-segment): Compare SEGMENT's offset + size to ELF's total size. (validate-needed-in-runpath): Wrap body in 'guard' form.
Diffstat (limited to 'guix/build')
-rw-r--r--guix/build/gremlin.scm78
1 files changed, 57 insertions, 21 deletions
diff --git a/guix/build/gremlin.scm b/guix/build/gremlin.scm
index 253713b587..24a7b558af 100644
--- a/guix/build/gremlin.scm
+++ b/guix/build/gremlin.scm
@@ -22,10 +22,17 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
#:use-module (system foreign)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
- #:export (elf-dynamic-info
+ #:export (elf-error?
+ elf-error-elf
+ invalid-segment-size?
+ invalid-segment-size-segment
+
+ elf-dynamic-info
elf-dynamic-info?
elf-dynamic-info-sopath
elf-dynamic-info-needed
@@ -41,12 +48,31 @@
;;;
;;; Code:
+(define-condition-type &elf-error &error
+ elf-error?
+ (elf elf-error-elf))
+
+(define-condition-type &invalid-segment-size &elf-error
+ invalid-segment-size?
+ (segment invalid-segment-size-segment))
+
+
(define (dynamic-link-segment elf)
"Return the 'PT_DYNAMIC' segment of ELF--i.e., the segment that contains
dynamic linking information."
- (find (lambda (segment)
- (= (elf-segment-type segment) PT_DYNAMIC))
- (elf-segments elf)))
+ (let ((size (bytevector-length (elf-bytes elf))))
+ (find (lambda (segment)
+ (unless (<= (+ (elf-segment-offset segment)
+ (elf-segment-filesz segment))
+ size)
+ ;; This happens on separate debug output files created by
+ ;; 'strip --only-keep-debug' (Binutils 2.25.)
+ (raise (condition (&invalid-segment-size
+ (elf elf)
+ (segment segment)))))
+
+ (= (elf-segment-type segment) PT_DYNAMIC))
+ (elf-segments elf))))
(define (word-reader size byte-order)
"Return a procedure to read a word of SIZE bytes according to BYTE-ORDER."
@@ -215,23 +241,33 @@ value of DT_NEEDED entries is a string.)"
present in its RUNPATH, or if FILE lacks dynamic-link information. Return #f
otherwise. Libraries whose name matches ALWAYS-FOUND? are considered to be
always available."
- (let* ((elf (call-with-input-file file
- (compose parse-elf get-bytevector-all)))
- (dyninfo (elf-dynamic-info elf)))
- (when dyninfo
- (let* ((runpath (elf-dynamic-info-runpath dyninfo))
- (needed (remove always-found?
- (elf-dynamic-info-needed dyninfo)))
- (not-found (remove (cut search-path runpath <>)
- needed)))
- (for-each (lambda (lib)
- (format (current-error-port)
- "error: '~a' depends on '~a', which cannot \
+ (guard (c ((invalid-segment-size? c)
+ (let ((segment (invalid-segment-size-segment c)))
+ (format (current-error-port)
+ "~a: error: offset + size of segment ~a (type ~a) \
+exceeds total size~%"
+ file
+ (elf-segment-index segment)
+ (elf-segment-type segment))
+ #f)))
+
+ (let* ((elf (call-with-input-file file
+ (compose parse-elf get-bytevector-all)))
+ (dyninfo (elf-dynamic-info elf)))
+ (when dyninfo
+ (let* ((runpath (elf-dynamic-info-runpath dyninfo))
+ (needed (remove always-found?
+ (elf-dynamic-info-needed dyninfo)))
+ (not-found (remove (cut search-path runpath <>)
+ needed)))
+ (for-each (lambda (lib)
+ (format (current-error-port)
+ "error: '~a' depends on '~a', which cannot \
be found in RUNPATH ~s~%"
- file lib runpath))
- not-found)
- ;; (when (null? not-found)
- ;; (format (current-error-port) "~a is OK~%" file))
- (null? not-found)))))
+ file lib runpath))
+ not-found)
+ ;; (when (null? not-found)
+ ;; (format (current-error-port) "~a is OK~%" file))
+ (null? not-found))))))
;;; gremlin.scm ends here