Hi,
Chicken has unchecked malloc() arguments in srfi-4:
http://lists.gnu.org/archive/html/chicken-announce/2017-03/msg00000.html
Here's backported patch to fix it.
Quickly tested on amd64, could use a bit more testing though.
Timo
Index: Makefile.inc
===================================================================
RCS file: /cvs/ports/lang/chicken/Makefile.inc,v
retrieving revision 1.10
diff -u -p -r1.10 Makefile.inc
--- Makefile.inc 25 Feb 2017 02:45:13 -0000 1.10
+++ Makefile.inc 16 Mar 2017 05:18:18 -0000
@@ -3,6 +3,7 @@
COMMENT= practical and portable Scheme system
V= 4.12.0
+REVISION= 0
DISTNAME= chicken-${V}
MAINTAINER= Timo Myyra <[email protected]>
Index: core/patches/patch-srfi-4_scm
===================================================================
RCS file: core/patches/patch-srfi-4_scm
diff -N core/patches/patch-srfi-4_scm
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ core/patches/patch-srfi-4_scm 16 Mar 2017 05:18:18 -0000
@@ -0,0 +1,96 @@
+$OpenBSD$
+Backport of security fix:
+ - Remove unchecked malloc() call in SRFI-4 constructors when
+ allocating in non-GC memory, resulting in potential 1-word
+ buffer overrun and/or segfault (thanks to Lemonboy).
+--- srfi-4.scm.orig Thu Mar 16 06:49:38 2017
++++ srfi-4.scm Thu Mar 16 06:57:14 2017
+@@ -256,16 +256,21 @@ EOF
+ ;;; Basic constructors:
+
+ (let* ([ext-alloc
+- (foreign-lambda* scheme-object ([int bytes])
+- "C_word *buf = (C_word *)C_malloc(bytes + sizeof(C_header));"
+- "if(buf == NULL) C_return(C_SCHEME_FALSE);"
++ (foreign-lambda* scheme-object ([size_t bytes])
++ "C_word *buf;"
++ "if (bytes > C_HEADER_SIZE_MASK) C_return(C_SCHEME_FALSE);"
++ "buf = (C_word *)C_malloc(bytes + sizeof(C_header));"
+ "C_block_header_init(buf, C_make_header(C_BYTEVECTOR_TYPE, bytes));"
++ "if(buf == NULL) C_return(C_SCHEME_FALSE);"
++ "C_block_header_init(buf, C_make_header(C_BYTEVECTOR_TYPE, bytes));"
+ "C_return(buf);") ]
+ [ext-free
+ (foreign-lambda* void ([scheme-object bv])
+ "C_free((void *)C_block_item(bv, 1));") ]
+ [alloc
+ (lambda (loc len ext?)
++ (##sys#check-exact len loc)
++ (when (fx< len 0) (##sys#error loc "size is negative" len))
+ (if ext?
+ (let ([bv (ext-alloc len)])
+ (or bv
+@@ -282,7 +287,6 @@ EOF
+
+ (set! make-u8vector
+ (lambda (len #!optional (init #f) (ext? #f) (fin? #t))
+- (##sys#check-exact len 'make-u8vector)
+ (let ((v (##sys#make-structure 'u8vector (alloc 'make-u8vector len
ext?))))
+ (when (and ext? fin?) (set-finalizer! v ext-free))
+ (if (not init)
+@@ -295,7 +299,6 @@ EOF
+
+ (set! make-s8vector
+ (lambda (len #!optional (init #f) (ext? #f) (fin? #t))
+- (##sys#check-exact len 'make-s8vector)
+ (let ((v (##sys#make-structure 's8vector (alloc 'make-s8vector len
ext?))))
+ (when (and ext? fin?) (set-finalizer! v ext-free))
+ (if (not init)
+@@ -308,7 +311,6 @@ EOF
+
+ (set! make-u16vector
+ (lambda (len #!optional (init #f) (ext? #f) (fin? #t))
+- (##sys#check-exact len 'make-u16vector)
+ (let ((v (##sys#make-structure 'u16vector (alloc 'make-u16vector
(##core#inline "C_fixnum_shift_left" len 1) ext?))))
+ (when (and ext? fin?) (set-finalizer! v ext-free))
+ (if (not init)
+@@ -321,7 +323,6 @@ EOF
+
+ (set! make-s16vector
+ (lambda (len #!optional (init #f) (ext? #f) (fin? #t))
+- (##sys#check-exact len 'make-s16vector)
+ (let ((v (##sys#make-structure 's16vector (alloc 'make-s16vector
(##core#inline "C_fixnum_shift_left" len 1) ext?))))
+ (when (and ext? fin?) (set-finalizer! v ext-free))
+ (if (not init)
+@@ -334,7 +335,6 @@ EOF
+
+ (set! make-u32vector
+ (lambda (len #!optional (init #f) (ext? #f) (fin? #t))
+- (##sys#check-exact len 'make-u32vector)
+ (let ((v (##sys#make-structure 'u32vector (alloc 'make-u32vector
(##core#inline "C_fixnum_shift_left" len 2) ext?))))
+ (when (and ext? fin?) (set-finalizer! v ext-free))
+ (if (not init)
+@@ -347,7 +347,6 @@ EOF
+
+ (set! make-s32vector
+ (lambda (len #!optional (init #f) (ext? #f) (fin? #t))
+- (##sys#check-exact len 'make-s32vector)
+ (let ((v (##sys#make-structure 's32vector (alloc 'make-s32vector
(##core#inline "C_fixnum_shift_left" len 2) ext?))))
+ (when (and ext? fin?) (set-finalizer! v ext-free))
+ (if (not init)
+@@ -360,7 +359,6 @@ EOF
+
+ (set! make-f32vector
+ (lambda (len #!optional (init #f) (ext? #f) (fin? #t))
+- (##sys#check-exact len 'make-f32vector)
+ (let ((v (##sys#make-structure 'f32vector (alloc 'make-f32vector
(##core#inline "C_fixnum_shift_left" len 2) ext?))))
+ (when (and ext? fin?) (set-finalizer! v ext-free))
+ (if (not init)
+@@ -375,7 +373,6 @@ EOF
+
+ (set! make-f64vector
+ (lambda (len #!optional (init #f) (ext? #f) (fin? #t))
+- (##sys#check-exact len 'make-f64vector)
+ (let ((v (##sys#make-structure
+ 'f64vector
+ (alloc 'make-f64vector (##core#inline "C_fixnum_shift_left" len
3) ext?))))
