community/chicken: security fixes #7402 (CVE-2017-9334)

3 files changed, 180 insertions, 4 deletions

diff --git a/community/chicken/APKBUILD b/community/chicken/APKBUILD
index 1711cd9445..320c636d34 100644
--- a/community/chicken/APKBUILD
+++ b/community/chicken/APKBUILD
@@ -3,7 +3,7 @@
 # Maintainer: Sören Tempel <soeren+alpine@soeren-tempel.net>
 pkgname=chicken
 pkgver=4.12.0
-pkgrel=1
+pkgrel=2
 pkgdesc="R5RS and R7RS compatible scheme compiler and interpreter"
 url="http://call-cc.org/"
 arch="all !ppc64le"
@@ -13,10 +13,14 @@ depends_dev=""
 makedepends="$depends_dev"
 install=""
 subpackages="$pkgname-doc $pkgname-libs $pkgname-dev $pkgname-feathers::noarch"
-source="http://code.call-cc.org/releases/$pkgver/$pkgname-$pkgver.tar.gz"
+source="http://code.call-cc.org/releases/$pkgver/$pkgname-$pkgver.tar.gz
+	CVE-2017-9334.patch
+	"
 
 # secfixes:
-#   4.11.1:
+#   4.12.0-r2:
+#     - CVE-2017-9334
+#   4.11.1-r0:
 #     - CVE-2016-6830
 #     - CVE-2016-6831
 
@@ -60,4 +64,5 @@ feathers() {
 		"$subpkgdir"/usr/share/chicken/ || return 1
 }
 
-sha512sums="190bdc9e53aa50e93419e2483fd5baf3e2ef3bebe4e605653f2aadd9b8bbc98b192cfbb64ab1c99eeefb13a7795757f013799963bfb775862d746ed5c93d602f  chicken-4.12.0.tar.gz"
+sha512sums="190bdc9e53aa50e93419e2483fd5baf3e2ef3bebe4e605653f2aadd9b8bbc98b192cfbb64ab1c99eeefb13a7795757f013799963bfb775862d746ed5c93d602f  chicken-4.12.0.tar.gz
+7d594a6abaffe59a050305878ba9cc75cf588743407b2cc44e369fb22a94d42662bf8101bec93b60cacdc0046da5bc74ff1e8ac8d9e6aacfb280406cbbabce7c  CVE-2017-9334.patch"
diff --git a/community/chicken/CVE-2017-6949.patch b/community/chicken/CVE-2017-6949.patch
new file mode 100644
index 0000000000..ac93f38046
--- /dev/null
+++ b/community/chicken/CVE-2017-6949.patch
@@ -0,0 +1,130 @@
+From: LemonBoy <thatlemon@gmail.com>
+Date: Fri, 10 Mar 2017 15:29:47 +0000 (+0100)
+Subject: Add bound checking to all srfi-4 vector allocations.
+X-Git-Url: https://code.call-cc.org/cgi-bin/gitweb.cgi?p=chicken-core.git;a=commitdiff_plain;h=68c4e537a29d3f878016e0144c42d0e7ae5d41b4
+
+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/srfi-4.scm b/srfi-4.scm
+index 7f5412b..69f58ba 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?))))
diff --git a/community/chicken/CVE-2017-9334.patch b/community/chicken/CVE-2017-9334.patch
new file mode 100644
index 0000000000..8b593fa58b
--- /dev/null
+++ b/community/chicken/CVE-2017-9334.patch
@@ -0,0 +1,41 @@
+From 76bbb0c92c0a9e2cadac9796e55fdd2836424fdb Mon Sep 17 00:00:00 2001
+From: Peter Bex <address@hidden>
+Date: Sun, 28 May 2017 12:37:44 +0200
+Subject: [PATCH] Fix segmentation fault in "length" on improper lists.
+
+This fixes #1375
+---
+ runtime.c               | 2 +-
+ tests/library-tests.scm | 6 ++++++
+ 3 files changed, 9 insertions(+), 1 deletion(-)
+
+diff --git a/runtime.c b/runtime.c
+index 86db413..7a513c2 100644
+--- a/runtime.c
++++ b/runtime.c
+@@ -5379,7 +5379,7 @@ C_regparm C_word C_fcall C_i_length(C_word lst)
+       }
+     }
+ 
+-    if(C_immediatep(slow) || C_block_header(lst) != C_PAIR_TAG)
++    if(C_immediatep(slow) || C_block_header(slow) != C_PAIR_TAG)
+       barf(C_NOT_A_PROPER_LIST_ERROR, "length", lst);
+ 
+     slow = C_u_i_cdr(slow);
+diff --git a/tests/library-tests.scm b/tests/library-tests.scm
+index cd2f6e9..9c7cab4 100644
+--- a/tests/library-tests.scm
++++ b/tests/library-tests.scm
+@@ -693,3 +693,9 @@ A
+ (assert (not (member "foo" '("bar"))))
+ (assert (not (member "foo" '())))
+ (assert-fail (member "foo" "foo"))
++
++
++;; length
++
++(assert-fail (length 1))
++(assert-fail (length '(x . y)))
+-- 
+2.1.4
+