ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 13:28:12 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gnu: chicken: Update to 4.12.0.

Browse source 
* gnu/packages/scheme.scm (chicken): Update to 4.12.0.
This commit is contained in:
Kei Kebreau 2017-03-21 14:54:04 -04:00
parent 112d645ffa
commit 359e9c4215
No known key found for this signature in database
GPG key ID: E6A5EE3C19467A0D
4 changed files with 137 additions and 94 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
gnu/local.mk
View file

@ -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 \

81
gnu/packages/patches/chicken-CVE-2016-6830+CVE-2016-6831.patch
View file

@ -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>

132
gnu/packages/patches/chicken-CVE-2017-6949.patch Normal file
View file

@ -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

16
gnu/packages/scheme.scm
View file

@ -325,18 +325,16 @@ (define-public hop
(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 @@ (define-public chicken
;; 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