[chicken/el6] rhbz#1181483

[Ricky Elrod]

commit 24cfce72963be83de7a81da6b95a6103c0849fc3
Author: Ricky Elrod <ricky at elrod.me>
Date:   Tue Jan 13 05:10:45 2015 -0500

    rhbz#1181483
    
    Signed-off-by: Ricky Elrod <ricky at elrod.me>

 chicken-4.9.0.1-2.el6.src.rpm |  Bin 0 -> 4014644 bytes
 chicken.spec                  |   11 +++++-
 rhbz-1181483.patch            |   80 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 89 insertions(+), 2 deletions(-)
---
diff --git a/chicken-4.9.0.1-2.el6.src.rpm b/chicken-4.9.0.1-2.el6.src.rpm
new file mode 100644
index 0000000..cfb50da
Binary files /dev/null and b/chicken-4.9.0.1-2.el6.src.rpm differ
diff --git a/chicken.spec b/chicken.spec
index 5324a53..5440e86 100644
--- a/chicken.spec
+++ b/chicken.spec
@@ -2,7 +2,7 @@
 
 Name:           chicken
 Version:        4.9.0.1
-Release:        1%{?dist}
+Release:        2%{?dist}
 Summary:        A practical and portable Scheme system
 
 Group:          Development/Languages
@@ -27,6 +27,8 @@ BuildRequires:  hostname
 BuildRequires:  chicken
 %endif
 
+Patch1: rhbz-1181483.patch
+
 %package libs
 Summary:        Chicken Scheme runtime library
 
@@ -42,6 +44,7 @@ Scheme language standard, and includes many enhancements and extensions.
 %prep
 %setup -q -n %{name}-%{version}
 %patch0 -p1
+%patch1 -p1
 
 %build
 %if %{bootstrap} == 0
@@ -116,7 +119,11 @@ chrpath --delete %{buildroot}/%{_bindir}/*
 %{_libdir}/libchicken.so*
 
 %changelog
-* Thu Aug 07 2014 Ricky Elrod <relrod at redhat.com> - 4.9.0.1-4
+* Tue Jan 13 2015 Ricky Elrod <relrod at redhat.com> - 4.9.0.1-2
+- Apply patch to work around buffer overrun:
+  https://bugzilla.redhat.com/show_bug.cgi?id=1181483
+
+* Thu Aug 07 2014 Ricky Elrod <relrod at redhat.com> - 4.9.0.1-1
 - Latest upstream release.
 
 * Sat Jun 07 2014 Ricky Elrod <relrod at redhat.com> - 4.9.0-4
diff --git a/rhbz-1181483.patch b/rhbz-1181483.patch
new file mode 100644
index 0000000..28a081c
--- /dev/null
+++ b/rhbz-1181483.patch
@@ -0,0 +1,80 @@
+From 230eed2745ea2b57de3c9073e8596892b1da2d8c Mon Sep 17 00:00:00 2001
+From: Moritz Heidkamp <address at hidden>
+Date: Sun, 14 Dec 2014 23:33:52 +0100
+Subject: [PATCH] Fix buffer overrun in substring-index[-ci]
+
+When passing a start index greater than 0, substring-index[-ci] would
+scan past the end of the subject string, leading to bogus results in
+case the substring is accidentally run into beyond the end of the
+subject. This patch fixes the issue and also adds a range check for the
+start index.
+---
+ data-structures.scm             | 22 ++++++++++++++--------
+ tests/data-structures-tests.scm | 11 ++++++++++-
+ 2 files changed, 24 insertions(+), 9 deletions(-)
+
+diff --git a/data-structures.scm b/data-structures.scm
+index a94c163..511a3c1 100644
+--- a/data-structures.scm
++++ b/data-structures.scm
+@@ -307,15 +307,21 @@
+   (define (traverse which where start test loc)
+     (##sys#check-string which loc)
+     (##sys#check-string where loc)
+-    (let ([wherelen (##sys#size where)]
+-	  [whichlen (##sys#size which)] )
++    (let* ((wherelen (##sys#size where))
++	   (whichlen (##sys#size which))
++	   (end (fx- wherelen whichlen)))
+       (##sys#check-exact start loc)
+-      (let loop ([istart start] [iend whichlen])
+-	(cond [(fx> iend wherelen) #f]
+-	      [(test istart whichlen) istart]
+-	      [else 
+-	       (loop (fx+ istart 1)
+-		     (fx+ iend 1) ) ] ) ) ) )
++      (if (and (fx>= start 0)
++	       (fx> wherelen start))
++	  (let loop ((istart start))
++	    (cond ((fx> istart end) #f)
++		  ((test istart whichlen) istart)
++		  (else (loop (fx+ istart 1)))))
++	  (##sys#error-hook (foreign-value "C_OUT_OF_RANGE_ERROR" int)
++			    loc
++			    start
++			    wherelen))))
++
+   (set! ##sys#substring-index 
+     (lambda (which where start)
+       (traverse 
+diff --git a/tests/data-structures-tests.scm b/tests/data-structures-tests.scm
+index 51c25a9..34ccb2f 100644
+--- a/tests/data-structures-tests.scm
++++ b/tests/data-structures-tests.scm
+@@ -1,6 +1,6 @@
+ ;;;; data-structures-tests.scm
+ 
+-(use data-structures)
++(use data-structures lolevel)
+ 
+ (define-syntax assert-error
+   (syntax-rules ()
+@@ -57,6 +57,15 @@
+ (assert (< 0 (string-compare3-ci "foo\x00b" "foo\x00a")))
+ (assert (< 0 (string-compare3-ci "foo\x00b" "foo\x00A")))
+ 
++
++;; This used to fail because substring-index and co. used to search
++;; beyond the end of the subject string when a start index > 0 was
++;; provided. We use object-evict to ensure that the strings are placed
++;; in adjacent memory ranges so we can detect this error.
++(let* ((foo (object-evict (make-string 32 #\x)))
++       (bar (object-evict "y")))
++  (assert (not (substring-index "y" foo 30))))
++
+ ;; topological-sort
+ 
+ (assert (equal? '() (topological-sort '() eq?)))
+-- 
+2.1.3
+