~ chicken-core (chicken-5) 68c4e537a29d3f878016e0144c42d0e7ae5d41b4

commit 68c4e537a29d3f878016e0144c42d0e7ae5d41b4
Author:     LemonBoy <thatlemon@gmail.com>
AuthorDate: Fri Mar 10 16:29:47 2017 +0100
Commit:     Kooda <kooda@upyum.com>
CommitDate: Wed Mar 15 00:28:36 2017 +0100

    Add bound checking to all srfi-4 vector allocations.
    
    Do what C_allocate_vector already does and prevent the creation of a
    vector that's too big or too small.
    We should be very careful to avoid the latter case because the
    allocation size is directly fed into `malloc' as 'x + sizeof(C_header)'
    thus making possible to successfully allocate a vector smaller than the
    C_header structure and get C_block_header_init to write over
    uninitialized memory.
    
    To reduce code duplication, type checking is moved from each of the
    make-*vector procedures to the common "alloc" helper procedure.
    
    Signed-off-by: Peter Bex <peter@more-magic.net>
    Signed-off-by: Kooda <kooda@upyum.com>

diff --git a/NEWS b/NEWS
index 32f51860..b134e0e4 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,10 @@
 4.12.1
 
+- Security fixes
+  - 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).
+
 - Core Libraries
   - Unit "posix": If file-lock, file-lock/blocking or file-unlock are
     interrupted by a signal, we now retry (thanks to Joerg Wittenberger).
diff --git a/srfi-4.scm b/srfi-4.scm
index 7f5412bd..69f58ba4 100644
--- a/srfi-4.scm
+++ b/srfi-4.scm
@@ -255,24 +255,28 @@ EOF
 
 ;;; Basic constructors:
 
-(let* ([ext-alloc
-	(foreign-lambda* scheme-object ([int bytes])
-	  "C_word *buf = (C_word *)C_malloc(bytes + sizeof(C_header));"
+(let* ((ext-alloc
+	(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));"
 	  "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
+	  "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)])
+	      (let ((bv (ext-alloc len)))
 		(or bv
 		    (##sys#error loc "not enough memory - cannot allocate external number vector" len)) )
-	      (let ([bv (##sys#allocate-vector len #t #f #t)]) ; this could be made better...
+	      (let ((bv (##sys#allocate-vector len #t #f #t))) ; this could be made better...
 		(##core#inline "C_string_to_bytevector" bv)
-		bv) ) ) ] )
+		bv) ) ) ) )
 
   (set! release-number-vector
     (lambda (v)
@@ -282,7 +286,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 +298,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 +310,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 +322,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 +334,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 +346,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 +358,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 +372,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?))))