Subject: bug#26212: closed (Re: bug#26212: [PATCH] gnu: chicken: Update to 4.12.0.)

From: [email-masked] (GNU bug Tracking System)
Date: Tue, 21 Mar 2017 22:23:02 +0000

Your bug report

#26212: [PATCH] gnu: chicken: Update to 4.12.0.

which was filed against the guix-patches package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
26212: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=26212
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: bug#26212: [PATCH] gnu: chicken: Update to 4.12.0.
From: Kei Kebreau <[email-masked]>
To: [email-masked]
Date: Tue, 21 Mar 2017 18:22:32 -0400
List-Id: <debbugs-submit.debbugs.gnu.org>

Duplicate of report 26209.

Kei Kebreau <[email-masked]> writes:

> * gnu/packages/scheme.scm (chicken): Update to 4.12.0.
> ---
>  .../chicken-CVE-2016-6830+CVE-2016-6831.patch      |  81 -------------
>  gnu/packages/patches/chicken-CVE-2017-6949.patch   | 132 +++++++++++++++++++++
>  gnu/packages/scheme.scm                            |  16 +--
>  3 files changed, 136 insertions(+), 93 deletions(-)
>  delete mode 100644 gnu/packages/patches/chicken-CVE-2016-6830+CVE-2016-6831.patch
>  create mode 100644 gnu/packages/patches/chicken-CVE-2017-6949.patch
>
> diff --git a/gnu/packages/patches/chicken-CVE-2016-6830+CVE-2016-6831.patch b/gnu/packages/patches/chicken-CVE-2016-6830+CVE-2016-6831.patch
> deleted file mode 100644
> index 59decde0e..000000000
> --- a/gnu/packages/patches/chicken-CVE-2016-6830+CVE-2016-6831.patch
> +++ /dev/null
> @@ -1,81 +0,0 @@
> -diff -ur a/irregex-core.scm b/irregex-core.scm
> ---- a/irregex-core.scm	2016-09-11 19:03:00.000000000 -0400
> -+++ b/irregex-core.scm	2017-01-01 22:24:08.000000000 -0500
> -@@ -30,6 +30,8 @@
> - 
> - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> - ;;;; History
> -+;; 0.9.6: 2016/12/05 - fixed exponential memory use of + in compilation
> -+;;                     of backtracking matcher.
> - ;; 0.9.5: 2016/09/10 - fixed a bug in irregex-fold handling of bow
> - ;; 0.9.4: 2015/12/14 - performance improvement for {n,m} matches
> - ;; 0.9.3: 2014/07/01 - R7RS library
> -@@ -3170,16 +3172,7 @@
> -               ((sre-empty? (sre-sequence (cdr sre)))
> -                (error "invalid sre: empty *" sre))
> -               (else
> --               (letrec
> --                   ((body
> --                     (lp (sre-sequence (cdr sre))
> --                         n
> --                         flags
> --                         (lambda (cnk init src str i end matches fail)
> --                           (body cnk init src str i end matches
> --                                 (lambda ()
> --                                   (next cnk init src str i end matches fail)
> --                                   ))))))
> -+               (let ((body (rec (list '+ (sre-sequence (cdr sre))))))
> -                  (lambda (cnk init src str i end matches fail)
> -                    (body cnk init src str i end matches
> -                          (lambda ()
> -@@ -3204,10 +3197,21 @@
> -                          (lambda ()
> -                            (body cnk init src str i end matches fail))))))))
> -             ((+)
> --             (lp (sre-sequence (cdr sre))
> --                 n
> --                 flags
> --                 (rec (list '* (sre-sequence (cdr sre))))))
> -+             (cond
> -+              ((sre-empty? (sre-sequence (cdr sre)))
> -+               (error "invalid sre: empty +" sre))
> -+              (else
> -+               (letrec
> -+                   ((body
> -+                     (lp (sre-sequence (cdr sre))
> -+                         n
> -+                         flags
> -+                         (lambda (cnk init src str i end matches fail)
> -+                           (body cnk init src str i end matches
> -+                                 (lambda ()
> -+                                   (next cnk init src str i end matches fail)
> -+                                   ))))))
> -+                 body))))
> -             ((=)
> -              (rec `(** ,(cadr sre) ,(cadr sre) ,@(cddr sre))))
> -             ((>=)
> -diff -ur a/irregex-utils.scm b/irregex-utils.scm
> ---- a/irregex-utils.scm	2016-09-11 19:03:00.000000000 -0400
> -+++ b/irregex-utils.scm	2017-01-01 22:25:25.000000000 -0500
> -@@ -89,7 +89,7 @@
> -         (case (car x)
> -           ((: seq)
> -            (cond
> --            ((and (pair? (cddr x)) (pair? (cddr x)) (not (eq? x obj)))
> -+            ((and (pair? (cdr x)) (pair? (cddr x)) (not (eq? x obj)))
> -              (display "(?:" out) (for-each lp (cdr x)) (display ")" out))
> -             (else (for-each lp (cdr x)))))
> -           ((submatch)
> -diff -ur "a/manual-html/Unit irregex.html" "b/manual-html/Unit irregex.html"
> ---- "a/manual-html/Unit irregex.html"	2016-09-11 19:10:47.000000000 -0400
> -+++ "b/manual-html/Unit irregex.html"	2017-01-01 22:26:05.000000000 -0500
> -@@ -353,6 +353,6 @@
> - <dd class="defsig"><p>Returns an optimized SRE matching any of the literal strings in the list, like Emacs' <tt>regexp-opt</tt>.  Note this optimization doesn't help when irregex is able to build a DFA.</p></dd>
> - </dl>
> - <h5 id="sec:sre-.3estring"><a href="#sec:sre-.3estring">sre-&gt;string</a></h5><dl class="defsig"><dt class="defsig" id="def:sre-.3estring"><span class="sig"><tt>(sre-&gt;string &lt;sre&gt;)</tt></span> <span class="type">procedure</span></dt>
> --<dd class="defsig"><p>Convert an SRE to a POSIX-style regular expression string, if possible.</p></dd>
> -+<dd class="defsig"><p>Convert an SRE to a PCRE-style regular expression string, if possible.</p></dd>
> - </dl>
> --<hr /><p>Previous: <a href="Unit%20extras.html">Unit extras</a></p><p>Next: <a href="Unit%20srfi-1.html">Unit srfi-1</a></p></div></div></body>
> -\ No newline at end of file
> -+<hr /><p>Previous: <a href="Unit%20extras.html">Unit extras</a></p><p>Next: <a href="Unit%20srfi-1.html">Unit srfi-1</a></p></div></div></body>
> diff --git a/gnu/packages/patches/chicken-CVE-2017-6949.patch b/gnu/packages/patches/chicken-CVE-2017-6949.patch
> new file mode 100644
> index 000000000..00552eec7
> --- /dev/null
> +++ b/gnu/packages/patches/chicken-CVE-2017-6949.patch
> @@ -0,0 +1,132 @@
> +From: LemonBoy <[email-masked]>
> +Date: Fri, 10 Mar 2017 16:29:47 +0100
> +Subject: [PATCH] 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 <[email-masked]>
> +Signed-off-by: Kooda <[email-masked]>
> +---
> + srfi-4.scm | 34 +++++++++++++++-------------------
> + 1 file changed, 15 insertions(+), 19 deletions(-)
> +
> +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?))))
> +--
> +2.1.4
> +
> diff --git a/gnu/packages/scheme.scm b/gnu/packages/scheme.scm
> index e1dba9bed..fec872f5f 100644
> --- a/gnu/packages/scheme.scm
> +++ b/gnu/packages/scheme.scm
> @@ -325,18 +325,16 @@ mashups, office (web agendas, mail clients, ...), etc.")
>  (define-public chicken
>    (package
>      (name "chicken")
> -    (version "4.11.1")
> +    (version "4.12.0")
>      (source (origin
>                (method url-fetch)
> -              (uri (string-append "http://code.call-cc.org/releases/"
> +              (uri (string-append "https://code.call-cc.org/releases/"
>                                    version "/chicken-" version ".tar.gz"))
> -              (uri (string-append "http://code.call-cc.org/dev-snapshots/"
> -                                  "2016/09/12/chicken-" version ".tar.gz"))
>                (sha256
>                 (base32
> -                "1rwymbbmnwdyhdzilv9w75an989xw9kjf3x52iqdng3nphpflcga"))
> +                "12b9gaa9lqh39lj1v4wm48f6z8ww3jdkvc5bh9gqqvn6kd2wwnk0"))
>                (patches
> -               (search-patches "chicken-CVE-2016-6830+CVE-2016-6831.patch"))))
> +               (search-patches "chicken-CVE-2017-6949.patch"))))
>      (build-system gnu-build-system)
>      (arguments
>       `(#:modules ((guix build gnu-build-system)
> @@ -359,12 +357,6 @@ mashups, office (web agendas, mail clients, ...), etc.")
>  
>         ;; Parallel builds are not supported, as noted in README.
>         #:parallel-build? #f))
> -    ;; One of the tests ("testing direct invocation can detect calls of too
> -    ;; many arguments...") times out when building with a more recent GCC.
> -    ;; The problem was reported here:
> -    ;; https://lists.gnu.org/archive/html/chicken-hackers/2015-04/msg00059.html
> -    (native-inputs
> -     `(("gcc" ,gcc-4.8)))
>      (home-page "http://www.call-cc.org/")
>      (synopsis "R5RS Scheme implementation that compiles native code via C")
>      (description

Subject: [PATCH] gnu: chicken: Update to 4.12.0.
From: Kei Kebreau <[email-masked]>
To: [email-masked], [email-masked]
Cc: Kei Kebreau <[email-masked]>
Date: Tue, 21 Mar 2017 16:51:35 -0400
List-Id: <debbugs-submit.debbugs.gnu.org>

* gnu/packages/scheme.scm (chicken): Update to 4.12.0.
---
 .../chicken-CVE-2016-6830+CVE-2016-6831.patch      |  81 -------------
 gnu/packages/patches/chicken-CVE-2017-6949.patch   | 132 +++++++++++++++++++++
 gnu/packages/scheme.scm                            |  16 +--
 3 files changed, 136 insertions(+), 93 deletions(-)
 delete mode 100644 gnu/packages/patches/chicken-CVE-2016-6830+CVE-2016-6831.patch
 create mode 100644 gnu/packages/patches/chicken-CVE-2017-6949.patch

diff --git a/gnu/packages/patches/chicken-CVE-2016-6830+CVE-2016-6831.patch b/gnu/packages/patches/chicken-CVE-2016-6830+CVE-2016-6831.patch
deleted file mode 100644
index 59decde0e..000000000
--- a/gnu/packages/patches/chicken-CVE-2016-6830+CVE-2016-6831.patch
+++ /dev/null
@@ -1,81 +0,0 @@
-diff -ur a/irregex-core.scm b/irregex-core.scm
---- a/irregex-core.scm	2016-09-11 19:03:00.000000000 -0400
-+++ b/irregex-core.scm	2017-01-01 22:24:08.000000000 -0500
-@@ -30,6 +30,8 @@
- 
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;;; History
-+;; 0.9.6: 2016/12/05 - fixed exponential memory use of + in compilation
-+;;                     of backtracking matcher.
- ;; 0.9.5: 2016/09/10 - fixed a bug in irregex-fold handling of bow
- ;; 0.9.4: 2015/12/14 - performance improvement for {n,m} matches
- ;; 0.9.3: 2014/07/01 - R7RS library
-@@ -3170,16 +3172,7 @@
-               ((sre-empty? (sre-sequence (cdr sre)))
-                (error "invalid sre: empty *" sre))
-               (else
--               (letrec
--                   ((body
--                     (lp (sre-sequence (cdr sre))
--                         n
--                         flags
--                         (lambda (cnk init src str i end matches fail)
--                           (body cnk init src str i end matches
--                                 (lambda ()
--                                   (next cnk init src str i end matches fail)
--                                   ))))))
-+               (let ((body (rec (list '+ (sre-sequence (cdr sre))))))
-                  (lambda (cnk init src str i end matches fail)
-                    (body cnk init src str i end matches
-                          (lambda ()
-@@ -3204,10 +3197,21 @@
-                          (lambda ()
-                            (body cnk init src str i end matches fail))))))))
-             ((+)
--             (lp (sre-sequence (cdr sre))
--                 n
--                 flags
--                 (rec (list '* (sre-sequence (cdr sre))))))
-+             (cond
-+              ((sre-empty? (sre-sequence (cdr sre)))
-+               (error "invalid sre: empty +" sre))
-+              (else
-+               (letrec
-+                   ((body
-+                     (lp (sre-sequence (cdr sre))
-+                         n
-+                         flags
-+                         (lambda (cnk init src str i end matches fail)
-+                           (body cnk init src str i end matches
-+                                 (lambda ()
-+                                   (next cnk init src str i end matches fail)
-+                                   ))))))
-+                 body))))
-             ((=)
-              (rec `(** ,(cadr sre) ,(cadr sre) ,@(cddr sre))))
-             ((>=)
-diff -ur a/irregex-utils.scm b/irregex-utils.scm
---- a/irregex-utils.scm	2016-09-11 19:03:00.000000000 -0400
-+++ b/irregex-utils.scm	2017-01-01 22:25:25.000000000 -0500
-@@ -89,7 +89,7 @@
-         (case (car x)
-           ((: seq)
-            (cond
--            ((and (pair? (cddr x)) (pair? (cddr x)) (not (eq? x obj)))
-+            ((and (pair? (cdr x)) (pair? (cddr x)) (not (eq? x obj)))
-              (display "(?:" out) (for-each lp (cdr x)) (display ")" out))
-             (else (for-each lp (cdr x)))))
-           ((submatch)
-diff -ur "a/manual-html/Unit irregex.html" "b/manual-html/Unit irregex.html"
---- "a/manual-html/Unit irregex.html"	2016-09-11 19:10:47.000000000 -0400
-+++ "b/manual-html/Unit irregex.html"	2017-01-01 22:26:05.000000000 -0500
-@@ -353,6 +353,6 @@
- <dd class="defsig"><p>Returns an optimized SRE matching any of the literal strings in the list, like Emacs' <tt>regexp-opt</tt>.  Note this optimization doesn't help when irregex is able to build a DFA.</p></dd>
- </dl>
- <h5 id="sec:sre-.3estring"><a href="#sec:sre-.3estring">sre-&gt;string</a></h5><dl class="defsig"><dt class="defsig" id="def:sre-.3estring"><span class="sig"><tt>(sre-&gt;string &lt;sre&gt;)</tt></span> <span class="type">procedure</span></dt>
--<dd class="defsig"><p>Convert an SRE to a POSIX-style regular expression string, if possible.</p></dd>
-+<dd class="defsig"><p>Convert an SRE to a PCRE-style regular expression string, if possible.</p></dd>
- </dl>
--<hr /><p>Previous: <a href="Unit%20extras.html">Unit extras</a></p><p>Next: <a href="Unit%20srfi-1.html">Unit srfi-1</a></p></div></div></body>
-\ No newline at end of file
-+<hr /><p>Previous: <a href="Unit%20extras.html">Unit extras</a></p><p>Next: <a href="Unit%20srfi-1.html">Unit srfi-1</a></p></div></div></body>
diff --git a/gnu/packages/patches/chicken-CVE-2017-6949.patch b/gnu/packages/patches/chicken-CVE-2017-6949.patch
new file mode 100644
index 000000000..00552eec7
--- /dev/null
+++ b/gnu/packages/patches/chicken-CVE-2017-6949.patch
@@ -0,0 +1,132 @@
+From: LemonBoy <[email-masked]>
+Date: Fri, 10 Mar 2017 16:29:47 +0100
+Subject: [PATCH] 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 <[email-masked]>
+Signed-off-by: Kooda <[email-masked]>
+---
+ srfi-4.scm | 34 +++++++++++++++-------------------
+ 1 file changed, 15 insertions(+), 19 deletions(-)
+
+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?))))
+--
+2.1.4
+
diff --git a/gnu/packages/scheme.scm b/gnu/packages/scheme.scm
index e1dba9bed..fec872f5f 100644
--- a/gnu/packages/scheme.scm
+++ b/gnu/packages/scheme.scm
@@ -325,18 +325,16 @@ mashups, office (web agendas, mail clients, ...), etc.")
 (define-public chicken
   (package
     (name "chicken")
-    (version "4.11.1")
+    (version "4.12.0")
     (source (origin
               (method url-fetch)
-              (uri (string-append "http://code.call-cc.org/releases/"
+              (uri (string-append "https://code.call-cc.org/releases/"
                                   version "/chicken-" version ".tar.gz"))
-              (uri (string-append "http://code.call-cc.org/dev-snapshots/"
-                                  "2016/09/12/chicken-" version ".tar.gz"))
               (sha256
                (base32
-                "1rwymbbmnwdyhdzilv9w75an989xw9kjf3x52iqdng3nphpflcga"))
+                "12b9gaa9lqh39lj1v4wm48f6z8ww3jdkvc5bh9gqqvn6kd2wwnk0"))
               (patches
-               (search-patches "chicken-CVE-2016-6830+CVE-2016-6831.patch"))))
+               (search-patches "chicken-CVE-2017-6949.patch"))))
     (build-system gnu-build-system)
     (arguments
      `(#:modules ((guix build gnu-build-system)
@@ -359,12 +357,6 @@ mashups, office (web agendas, mail clients, ...), etc.")
 
        ;; Parallel builds are not supported, as noted in README.
        #:parallel-build? #f))
-    ;; One of the tests ("testing direct invocation can detect calls of too
-    ;; many arguments...") times out when building with a more recent GCC.
-    ;; The problem was reported here:
-    ;; https://lists.gnu.org/archive/html/chicken-hackers/2015-04/msg00059.html
-    (native-inputs
-     `(("gcc" ,gcc-4.8)))
     (home-page "http://www.call-cc.org/")
     (synopsis "R5RS Scheme implementation that compiles native code via C")
     (description
-- 
2.12.0