~ chicken-core (chicken-5) 55e9d1e1768865c26409d483269bf03c8c351da2

commit 55e9d1e1768865c26409d483269bf03c8c351da2
Author:     Moritz Heidkamp <moritz.heidkamp@bevuta.com>
AuthorDate: Sat Sep 5 00:24:32 2015 +0200
Commit:     Peter Bex <peter@more-magic.net>
CommitDate: Thu Sep 10 20:38:59 2015 +0200

    Fix unsafe specializations in types.db
    
    This patch fixes some specializations in types.db which could lead to
    unsafe code. In all cases, the specialized versions did not only elide
    runtime type checks but also range checks for their arguments. For
    example, `string-ref' could have been specialized so that it would allow
    for an index pointing past the end of the string to be passed.
    
    Fixes #1216.
    
    Signed-off-by: Peter Bex <peter@more-magic.net>

diff --git a/NEWS b/NEWS
index 5d033966..6020e430 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,10 @@
 4.10.2
 
+- Security fixes
+  - Specialisation rules for string-{ref,set!}, bit-set?
+    and move-memory no longer use unchecked C functions which could
+    result in undefined behaviour, including buffer overruns (#1216).
+
 - Platform support
   - CHICKEN now supports the Linux X32 ABI (thanks to Sven Hartrumpf).
 
diff --git a/types.db b/types.db
index b79020c9..40588721 100644
--- a/types.db
+++ b/types.db
@@ -551,10 +551,10 @@
 	       ((string) (##sys#size #(1))))
 
 (string-ref (#(procedure #:clean #:enforce) string-ref (string fixnum) char)
-	    ((string fixnum) (##core#inline "C_subchar" #(1) #(2))))
+	    ((string fixnum) (##core#inline "C_i_string_ref" #(1) #(2))))
 
 (string-set! (#(procedure #:enforce) string-set! (string fixnum char) undefined)
-	     ((string fixnum char) (##core#inline "C_setsubchar" #(1) #(2) #(3))))
+	     ((string fixnum char) (##core#inline "C_i_string_set" #(1) #(2) #(3))))
 
 (string-append (#(procedure #:clean #:enforce) string-append (#!rest string) string)
 	       ((string string) (##sys#string-append #(1) #(2))))
@@ -731,7 +731,7 @@
 (arithmetic-shift (#(procedure #:clean #:enforce) arithmetic-shift (number number) number))
 
 (bit-set? (#(procedure #:clean #:enforce) bit-set? (number fixnum) boolean)
-	  ((fixnum fixnum) (##core#inline "C_u_i_bit_setp" #(1) #(2))))
+	  ((fixnum fixnum) (##core#inline "C_i_bit_setp" #(1) #(2))))
 
 (bitwise-and (#(procedure #:clean #:enforce) bitwise-and (#!rest number) number)
 	     ((fixnum fixnum) (fixnum)
@@ -1488,19 +1488,7 @@
 (make-record-instance (#(procedure #:clean) make-record-instance (symbol #!rest) *))
 (make-weak-locative (#(procedure #:clean #:enforce) make-weak-locative (* #!optional fixnum) locative))
 
-(move-memory! (#(procedure #:enforce) move-memory! (* * #!optional fixnum fixnum fixnum) *)
-	      ((pointer pointer fixnum)
-	       (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) '0 '0))
-	      ((pointer pointer fixnum fixnum)
-	       (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) '0 #(4)))
-	      ((pointer pointer fixnum fixnum fixnum)
-	       (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) #(5) #(4)))
-	      ((locative locative fixnum)
-	       (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) '0 '0))
-	      ((locative locative fixnum fixnum)
-	       (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) '0 #(4)))
-	      ((locative locative fixnum fixnum fixnum)
-	       (##core#inline "C_copy_ptr_memory" #(2) #(1) #(3) #(5) #(4))))
+(move-memory! (#(procedure #:enforce) move-memory! (* * #!optional fixnum fixnum fixnum) *))
 
 (mutate-procedure!
  (#(procedure #:enforce) mutate-procedure! (procedure (procedure (procedure) . *)) procedure))