diff options
author | Ludovic Courtès <ludo@gnu.org> | 2015-04-01 14:02:49 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2015-04-01 14:17:39 +0200 |
commit | 7be8c63e0de635f8c669dc19d7ac1d3cdbe28894 (patch) | |
tree | 4de659503edd1df1b3cb5165d8d82ccdfd82513a /guix/build | |
parent | d83ccc9b428fededaa6ec29a0df7b2728ad734f3 (diff) | |
download | gnu-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.scm | 78 |
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 |