diff options
| -rw-r--r-- | gnu/local.mk | 2 | ||||
| -rw-r--r-- | gnu/packages/patches/chicken-CVE-2016-6830+CVE-2016-6831.patch | 81 | ||||
| -rw-r--r-- | gnu/packages/patches/chicken-CVE-2017-6949.patch | 132 | ||||
| -rw-r--r-- | gnu/packages/scheme.scm | 16 |
4 files changed, 137 insertions, 94 deletions
diff --git a/gnu/local.mk b/gnu/local.mk index 97ca3eb720..0eb18f26c1 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -505,7 +505,7 @@ dist_patch_DATA = \ %D%/packages/patches/calibre-drop-unrar.patch \ %D%/packages/patches/calibre-no-updates-dialog.patch \ %D%/packages/patches/cdparanoia-fpic.patch \ - %D%/packages/patches/chicken-CVE-2016-6830+CVE-2016-6831.patch \ + %D%/packages/patches/chicken-CVE-2017-6949.patch \ %D%/packages/patches/chmlib-inttypes.patch \ %D%/packages/patches/clang-libc-search-path.patch \ %D%/packages/patches/clang-3.8-libc-search-path.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 59decde0e9..0000000000 --- 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 0000000000..00552eec76 --- /dev/null +++ b/gnu/packages/patches/chicken-CVE-2017-6949.patch @@ -0,0 +1,132 @@ +From: LemonBoy <thatlemon@gmail.com> +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 <peter@more-magic.net> +Signed-off-by: Kooda <kooda@upyum.com> +--- + 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 e1dba9bed7..fec872f5f9 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 |