ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-13 22:50:23 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gremlin: Guard against invalid ELF segments.

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2015-04-01 14:02:49 +02:00
parent d83ccc9b42
commit 7be8c63e0d
1 changed files with 57 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

78
guix/build/gremlin.scm
View file

@ -22,10 +22,17 @@ (define-module (guix build gremlin)
#: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 @@ (define-module (guix build gremlin)
;;;
;;; 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 @@ (define* (validate-needed-in-runpath file
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