~ chicken-core (master) dfc21b56436d1ce83911a66e85f90297bfee4136


commit dfc21b56436d1ce83911a66e85f90297bfee4136
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Tue Jun 30 13:22:12 2026 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Tue Jun 30 14:19:55 2026 +0200

    Fix a few foreign blob allocations to use bytevectors instead of strings
    
    With the new allocation scheme, strings are a wrapper object.  The
    memory allocated for these blobs would live in the wrapped bytevector,
    so passing it directly as a scheme-pointer would result in an out of
    bounds read or write.
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

diff --git a/posix-common.scm b/posix-common.scm
index d4fec5ed..5b334072 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -609,7 +609,7 @@ EOF
   (let ((tm-size (foreign-value "sizeof(struct tm)" int)))
     (lambda (tm)
       (check-time-vector 'local-time->seconds tm)
-      (let ((t (##core#inline_allocate ("C_a_mktime" 7) tm (##sys#make-string tm-size #\nul))))
+      (let ((t (##core#inline_allocate ("C_a_mktime" 7) tm (##sys#make-bytevector tm-size 0))))
         (if (= -1 t)
             (##sys#error 'local-time->seconds "cannot convert time vector to seconds" tm)
             t)))))
@@ -623,9 +623,9 @@ EOF
       (if fmt
           (begin
             (##sys#check-string fmt 'time->string)
-            (or (strftime tm (##sys#make-c-string fmt 'time->string) (##sys#make-string tm-size #\nul))
+            (or (strftime tm (##sys#make-c-string fmt 'time->string) (##sys#make-bytevector tm-size 0))
                 (##sys#error 'time->string "time formatting overflows buffer" tm)) )
-          (let ([str (asctime tm (##sys#make-string tm-size #\nul))])
+          (let ([str (asctime tm (##sys#make-bytevector tm-size 0))])
             (if str
                 (##sys#substring str 0 (fx- (string-length str) 1))
                 (##sys#error 'time->string "cannot convert time vector to string" tm) ) ) ) ) ) )
diff --git a/posixunix.scm b/posixunix.scm
index cd429f23..a9f0ebd6 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -1064,13 +1064,13 @@ static int set_file_mtime(C_word filename, C_word atime, C_word mtime)
     (lambda (tim #!optional (fmt "%a %b %e %H:%M:%S %Z %Y"))
       (##sys#check-string tim 'string->time)
       (##sys#check-string fmt 'string->time)
-      (strptime (##sys#make-c-string tim 'string->time) (##sys#make-c-string fmt) (make-vector 10 #f) (##sys#make-string tm-size #\nul)) ) ) )
+      (strptime (##sys#make-c-string tim 'string->time) (##sys#make-c-string fmt) (make-vector 10 #f) (##sys#make-bytevector tm-size 0)) ) ) )
 
 (set! chicken.time.posix#utc-time->seconds
   (let ((tm-size (foreign-value "sizeof(struct tm)" int)))
     (lambda (tm)
       (check-time-vector 'utc-time->seconds tm)
-      (let ((t (##core#inline_allocate ("C_a_timegm" 7) tm (##sys#make-string tm-size #\nul))))
+      (let ((t (##core#inline_allocate ("C_a_timegm" 7) tm (##sys#make-bytevector tm-size 0))))
         (if (= -1 t)
             (##sys#error 'utc-time->seconds "cannot convert time vector to seconds" tm)
             t)))))
diff --git a/posixwin.scm b/posixwin.scm
index 6415545e..673f545c 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -553,9 +553,9 @@ static int set_file_mtime(C_word filename, C_word atime, C_word mtime)
   (lambda (fd size . buffer)
     (##sys#check-fixnum fd 'file-read)
     (##sys#check-fixnum size 'file-read)
-    (let ([buf (if (pair? buffer) (car buffer) (make-string size))])
-      (unless (and (##core#inline "C_blockp" buf) (##core#inline "C_byteblockp" buf))
-	(##sys#signal-hook #:type-error 'file-read "bad argument type - not a string or bytevector" buf) )
+    (let ([buf (if (pair? buffer) (car buffer) (##sys#make-bytevector size))])
+      (unless (##core#inline "C_byteblockp" buf)
+	(##sys#signal-hook #:type-error 'file-read "bad argument type - not a bytevector" buf) )
       (let ([n (##core#inline "C_read" fd buf size)])
 	(when (eq? -1 n)
           (##sys#signal-hook/errno
diff --git a/tcp.scm b/tcp.scm
index 11d5f908..a20539b0 100644
--- a/tcp.scm
+++ b/tcp.scm
@@ -301,7 +301,7 @@ EOF
     "addr->sin_addr.s_addr = htonl(INADDR_ANY);") )
 
 (define (bind-socket style host port)
-  (let ((addr (make-string _sockaddr_in_size)))
+  (let ((addr (##sys#make-bytevector _sockaddr_in_size)))
     (if host
 	(unless (gethostaddr addr host port)
 	  (##sys#signal-hook 
@@ -627,7 +627,7 @@ EOF
 (define (tcp-connect host #!optional port (enc 'utf-8))
   (let* ((tmc (tcp-connect-timeout))
 	 (dlc (and tmc (+ (current-process-milliseconds) tmc)))
-	 (addr (make-string _sockaddr_in_size)))
+	 (addr (##sys#make-bytevector _sockaddr_in_size)))
     (##sys#check-string host)
     (unless port
       (set!-values (host port) (parse-host host "tcp"))
Trap