[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#26212: [PATCH] gnu: chicken: Update to 4.12.0.
|
From: |
Kei Kebreau |
|
Subject: |
bug#26212: [PATCH] gnu: chicken: Update to 4.12.0. |
|
Date: |
Tue, 21 Mar 2017 18:22:32 -0400 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/25.1 (gnu/linux) |
Duplicate of report 26209.
Kei Kebreau <address@hidden> 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->string</a></h5><dl class="defsig"><dt
> class="defsig" id="def:sre-.3estring"><span class="sig"><tt>(sre->string
> <sre>)</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 <address@hidden>
> +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 <address@hidden>
> +Signed-off-by: Kooda <address@hidden>
> +---
> + 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
signature.asc
Description: PGP signature