The following patch was adapted for CHICKEN Scheme
by Kei Kebreau <kei@openmailbox.org> based on:

https://lists.nongnu.org/archive/html/chicken-hackers/2016-07/txtSWHYeFeG0R.txt

diff -r -u a/NEWS b/NEWS
--- a/NEWS	2016-12-22 14:06:40.016494788 -0500
+++ b/NEWS	2016-12-22 14:06:49.216803605 -0500
@@ -27,6 +27,12 @@
   - The signal handling code can no longer trigger "stack overflow" or
     "recursion too deep or circular data encountered" errors (#1283).
 
+- Security fixes
+  - Fix buffer overrun due to excessively long argument or
+    environment lists in process-execute and process-spawn (#1308).
+    This also removes unnecessary limitations on the length of
+    these lists (thanks to Vasilij Schneidermann).
+
 - Compiler:
   - Specializations on implicit "or" types like "number" or "boolean" now
     work, removing the requirement for the inferred types to match
diff -r -u a/posix-common.scm b/posix-common.scm
--- a/posix-common.scm	2016-12-22 14:06:40.024495057 -0500
+++ b/posix-common.scm	2016-12-22 14:06:55.961030020 -0500
@@ -25,7 +25,8 @@
 
 
 (declare 
-  (hide ##sys#stat posix-error check-time-vector ##sys#find-files)
+  (hide ##sys#stat posix-error check-time-vector ##sys#find-files
+	list->c-string-buffer free-c-string-buffer call-with-exec-args)
   (foreign-declare #<<EOF
 
 #include <signal.h>
@@ -679,3 +680,65 @@
           (if (fx= epid -1)
               (posix-error #:process-error 'process-wait "waiting for child process failed" pid)
               (values epid enorm ecode) ) ) ) ) ) )
+
+;; This can construct argv or envp for process-execute or process-run
+(define list->c-string-buffer
+  (let* ((c-string->allocated-pointer
+	  (foreign-lambda* c-pointer ((scheme-object o))
+	    "char *ptr = malloc(C_header_size(o)); \n"
+	    "if (ptr != NULL) {\n"
+	    "  C_memcpy(ptr, C_data_pointer(o), C_header_size(o)); \n"
+	    "}\n"
+	    "C_return(ptr);")) )
+    (lambda (string-list convert loc)
+      (##sys#check-list string-list loc)
+
+      (let* ((string-count (##sys#length string-list))
+	     ;; NUL-terminated, so we must add one
+	     (buffer (make-pointer-vector (add1 string-count) #f)))
+
+	(handle-exceptions exn
+	    ;; Free to avoid memory leak, then reraise
+	    (begin (free-c-string-buffer buffer) (signal exn))
+
+	  (do ((sl string-list (cdr sl))
+	       (i 0 (fx+ i 1)) )
+	      ((or (null? sl) (fx= i string-count))) ; Should coincide
+
+	    (##sys#check-string (car sl) loc)
+	    ;; This avoids embedded NULs and appends a NUL, so "cs" is
+	    ;; safe to copy and use as-is in the pointer-vector.
+	    (let* ((cs (##sys#make-c-string (convert (car sl)) loc))
+		   (csp (c-string->allocated-pointer cs)))
+	      (unless csp (error loc "Out of memory"))
+	      (pointer-vector-set! buffer i csp)) )
+
+	  buffer) ) ) ) )
+
+(define (free-c-string-buffer buffer-array)
+  (let ((size (pointer-vector-length buffer-array)))
+    (do ((i 0 (fx+ i 1)))
+	((fx= i size))
+      (and-let* ((s (pointer-vector-ref buffer-array i)))
+	(free s)))))
+
+(define call-with-exec-args
+  (let ((pathname-strip-directory pathname-strip-directory)
+	(nop (lambda (x) x)))
+    (lambda (loc filename argconv arglist envlist proc)
+      (let* ((stripped-filename (pathname-strip-directory filename))
+	     (args (cons stripped-filename arglist)) ; Add argv[0]
+	     (argbuf (list->c-string-buffer args argconv loc))
+	     (envbuf #f))
+
+	(handle-exceptions exn
+	    ;; Free to avoid memory leak, then reraise
+	    (begin (free-c-string-buffer argbuf)
+		   (when envbuf (free-c-string-buffer envbuf))
+		   (signal exn))
+
+	  ;; Envlist is never converted, so we always use nop here
+	  (when envlist
+	    (set! envbuf (list->c-string-buffer envlist nop loc)))
+
+	  (proc (##sys#make-c-string filename loc) argbuf envbuf) )))))
diff -r -u a/posixunix.scm b/posixunix.scm
--- a/posixunix.scm	2016-12-22 14:06:39.976493446 -0500
+++ b/posixunix.scm	2016-12-22 14:06:55.961030020 -0500
@@ -27,7 +27,7 @@
 
 (declare
   (unit posix)
-  (uses scheduler irregex extras files ports)
+  (uses scheduler irregex extras files ports lolevel)
   (disable-interrupts)
   (hide group-member _get-groups _ensure-groups posix-error ##sys#terminal-check)
   (not inline ##sys#interrupt-hook ##sys#user-interrupt-hook))
@@ -88,10 +88,6 @@
 # define O_TEXT          0
 #endif
 
-#ifndef ARG_MAX
-# define ARG_MAX 256
-#endif
-
 #ifndef MAP_FILE
 # define MAP_FILE    0
 #endif
@@ -110,16 +106,10 @@
 # define C_getenventry(i)       (environ[ i ])
 #endif
 
-#ifndef ENV_MAX
-# define ENV_MAX        1024
-#endif
-
 #ifndef FILENAME_MAX
 # define FILENAME_MAX          1024
 #endif
 
-static C_TLS char *C_exec_args[ ARG_MAX ];
-static C_TLS char *C_exec_env[ ENV_MAX ];
 static C_TLS struct utsname C_utsname;
 static C_TLS struct flock C_flock;
 static C_TLS DIR *temphandle;
@@ -199,29 +189,8 @@
 
 #define C_lstat(fn)         C_fix(lstat((char *)C_data_pointer(fn), &C_statbuf))
 
-static void C_fcall C_set_arg_string(char **where, int i, char *a, int len) {
-  char *ptr;
-  if(a != NULL) {
-    ptr = (char *)C_malloc(len + 1);
-    C_memcpy(ptr, a, len);
-    ptr[ len ] = '\0';
-    /* Can't barf() here, so the NUL byte check happens in Scheme */
-  }
-  else ptr = NULL;
-  where[ i ] = ptr;
-}
-
-static void C_fcall C_free_arg_string(char **where) {
-  while((*where) != NULL) C_free(*(where++));
-}
-
-#define C_set_exec_arg(i, a, len)	C_set_arg_string(C_exec_args, i, a, len)
-#define C_free_exec_args()		C_free_arg_string(C_exec_args)
-#define C_set_exec_env(i, a, len)	C_set_arg_string(C_exec_env, i, a, len)
-#define C_free_exec_env()		C_free_arg_string(C_exec_env)
-
-#define C_execvp(f)         C_fix(execvp(C_data_pointer(f), C_exec_args))
-#define C_execve(f)         C_fix(execve(C_data_pointer(f), C_exec_args, C_exec_env))
+#define C_u_i_execvp(f,a)   C_fix(execvp(C_data_pointer(f), (char *const *)C_c_pointer_vector_or_null(a)))
+#define C_u_i_execve(f,a,e) C_fix(execve(C_data_pointer(f), (char *const *)C_c_pointer_vector_or_null(a), (char *const *)C_c_pointer_vector_or_null(e)))
 
 #if defined(__FreeBSD__) || defined(C_MACOSX) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(__sgi__) || defined(sgi) || defined(__DragonFly__) || defined(__SUNPRO_C)
 static C_TLS int C_uw;
@@ -1591,43 +1560,15 @@
 	       (exit 0)))
 	    pid)))))
 
-(define process-execute
-  ;; NOTE: We use c-string here instead of scheme-object.
-  ;; Because set_exec_* make a copy, this implies a double copy.
-  ;; At least it's secure, we can worry about performance later, if at all
-  (let ([setarg (foreign-lambda void "C_set_exec_arg" int c-string int)]
-        [freeargs (foreign-lambda void "C_free_exec_args")]
-        [setenv (foreign-lambda void "C_set_exec_env" int c-string int)]
-        [freeenv (foreign-lambda void "C_free_exec_env")]
-        [pathname-strip-directory pathname-strip-directory] )
-    (lambda (filename #!optional (arglist '()) envlist)
-      (##sys#check-string filename 'process-execute)
-      (##sys#check-list arglist 'process-execute)
-      (let ([s (pathname-strip-directory filename)])
-        (setarg 0 s (##sys#size s)) )
-      (do ([al arglist (cdr al)]
-           [i 1 (fx+ i 1)] )
-          ((null? al)
-           (setarg i #f 0)
-           (when envlist
-             (##sys#check-list envlist 'process-execute)
-             (do ([el envlist (cdr el)]
-                  [i 0 (fx+ i 1)] )
-                 ((null? el) (setenv i #f 0))
-               (let ([s (car el)])
-                 (##sys#check-string s 'process-execute)
-                 (setenv i s (##sys#size s)) ) ) )
-           (let* ([prg (##sys#make-c-string filename 'process-execute)]
-                  [r (if envlist
-                         (##core#inline "C_execve" prg)
-                         (##core#inline "C_execvp" prg) )] )
-             (when (fx= r -1)
-               (freeargs)
-               (freeenv)
-               (posix-error #:process-error 'process-execute "cannot execute process" filename) ) ) )
-        (let ([s (car al)])
-          (##sys#check-string s 'process-execute)
-          (setarg i s (##sys#size s)) ) ) ) ) )
+(define (process-execute filename #!optional (arglist '()) envlist)
+  (call-with-exec-args
+   'process-execute filename (lambda (x) x) arglist envlist
+   (lambda (prg argbuf envbuf)
+     (let ((r (if envbuf
+		  (##core#inline "C_u_i_execve" prg argbuf envbuf)
+		  (##core#inline "C_u_i_execvp" prg argbuf) )) )
+       (when (fx= r -1)
+	 (posix-error #:process-error 'process-execute "cannot execute process" filename) ) )))  )
 
 (define-foreign-variable _wnohang int "WNOHANG")
 (define-foreign-variable _wait-status int "C_wait_status")
diff -r -u a/posixwin.scm b/posixwin.scm
--- a/posixwin.scm	2016-12-22 14:06:40.016494788 -0500
+++ b/posixwin.scm	2016-12-22 14:06:55.961030020 -0500
@@ -63,9 +63,9 @@
 
 (declare
   (unit posix)
-  (uses scheduler irregex extras files ports)
+  (uses scheduler irregex extras files ports lolevel)
   (disable-interrupts)
-  (hide $quote-args-list $exec-setup $exec-teardown)
+  (hide quote-arg-string)
   (not inline ##sys#interrupt-hook ##sys#user-interrupt-hook)
   (foreign-declare #<<EOF
 #ifndef WIN32_LEAN_AND_MEAN
@@ -81,14 +81,8 @@
 #include <utime.h>
 #include <winsock2.h>
 
-#define ARG_MAX		256
 #define PIPE_BUF	512
-#ifndef ENV_MAX
-# define ENV_MAX	1024
-#endif
 
-static C_TLS char *C_exec_args[ ARG_MAX ];
-static C_TLS char *C_exec_env[ ENV_MAX ];
 static C_TLS struct group *C_group;
 static C_TLS int C_pipefds[ 2 ];
 static C_TLS time_t C_secs;
@@ -218,39 +212,12 @@
 
 #define C_lstat(fn)	    C_stat(fn)
 
-static void C_fcall
-C_set_arg_string(char **where, int i, char *dat, int len)
-{
-    char *ptr;
-    if (dat)
-    {
-	ptr = (char *)C_malloc(len + 1);
-	C_memcpy(ptr, dat, len);
-	ptr[ len ] = '\0';
-        /* Can't barf() here, so the NUL byte check happens in Scheme */
-    }
-    else
-	ptr = NULL;
-    where[ i ] = ptr;
-}
-
-static void C_fcall
-C_free_arg_string(char **where) {
-  while (*where) C_free(*(where++));
-}
-
-#define C_set_exec_arg(i, a, len)	C_set_arg_string(C_exec_args, i, a, len)
-#define C_set_exec_env(i, a, len)	C_set_arg_string(C_exec_env, i, a, len)
-
-#define C_free_exec_args()		(C_free_arg_string(C_exec_args), C_SCHEME_TRUE)
-#define C_free_exec_env()		(C_free_arg_string(C_exec_env), C_SCHEME_TRUE)
-
-#define C_execvp(f)	    C_fix(execvp(C_data_pointer(f), (const char *const *)C_exec_args))
-#define C_execve(f)	    C_fix(execve(C_data_pointer(f), (const char *const *)C_exec_args, (const char *const *)C_exec_env))
+#define C_u_i_execvp(f,a)   C_fix(execvp(C_data_pointer(f), (const char *const *)C_c_pointer_vector_or_null(a)))
+#define C_u_i_execve(f,a,e) C_fix(execve(C_data_pointer(f), (const char *const *)C_c_pointer_vector_or_null(a), (const char *const *)C_c_pointer_vector_or_null(e)))
 
 /* MS replacement for the fork-exec pair */
-#define C_spawnvp(m, f)	    C_fix(spawnvp(C_unfix(m), C_data_pointer(f), (const char *const *)C_exec_args))
-#define C_spawnvpe(m, f)    C_fix(spawnvpe(C_unfix(m), C_data_pointer(f), (const char *const *)C_exec_args, (const char *const *)C_exec_env))
+#define C_u_i_spawnvp(m,f,a) C_fix(spawnvp(C_unfix(m), C_data_pointer(f), (const char *const *)C_c_pointer_vector_or_null(a)))
+#define C_u_i_spawnvpe(m,f,a,e) C_fix(spawnvpe(C_unfix(m), C_data_pointer(f), (const char *const *)C_c_pointer_vector_or_null(a), (const char *const *)C_c_pointer_vector_or_null(e)))
 
 #define C_open(fn, fl, m)   C_fix(open(C_c_string(fn), C_unfix(fl), C_unfix(m)))
 #define C_read(fd, b, n)    C_fix(read(C_unfix(fd), C_data_pointer(b), C_unfix(n)))
@@ -1161,74 +1128,45 @@
 ; Windows uses a commandline style for process arguments. Thus any
 ; arguments with embedded whitespace will parse incorrectly. Must
 ; string-quote such arguments.
-(define $quote-args-list
-  (lambda (lst exactf)
-    (if exactf
-	lst
-	(let ([needs-quoting?
-					; This is essentially (string-any char-whitespace? s) but we don't
-					; want a SRFI-13 dependency. (Do we?)
-	       (lambda (s)
-		 (let ([len (string-length s)])
-		   (let loop ([i 0])
-		     (cond
-		      [(fx= i len) #f]
-		      [(char-whitespace? (string-ref s i)) #t]
-		      [else (loop (fx+ i 1))]))))])
-	  (let loop ([ilst lst] [olst '()])
-	    (if (null? ilst)
-		(##sys#fast-reverse olst)
-		(let ([str (car ilst)])
-		  (loop
-		   (cdr ilst)
-		   (cons
-		    (if (needs-quoting? str) (string-append "\"" str "\"") str)
-		    olst)) ) ) ) ) ) ) )
-
-(define $exec-setup
-  ;; NOTE: We use c-string here instead of scheme-object.
-  ;; Because set_exec_* make a copy, this implies a double copy.
-  ;; At least it's secure, we can worry about performance later, if at all
-  (let ([setarg (foreign-lambda void "C_set_exec_arg" int c-string int)]
-	[setenv (foreign-lambda void "C_set_exec_env" int c-string int)]
-	[build-exec-argvec
-	  (lambda (loc lst argvec-setter idx)
-	    (if lst
-	      (begin
-		(##sys#check-list lst loc)
-		(do ([l lst (cdr l)]
-		     [i idx (fx+ i 1)] )
-		    ((null? l) (argvec-setter i #f 0))
-		  (let ([s (car l)])
-		    (##sys#check-string s loc)
-		    (argvec-setter i s (##sys#size s)) ) ) )
-	      (argvec-setter idx #f 0) ) )])
-    (lambda (loc filename arglst envlst exactf)
-      (##sys#check-string filename loc)
-      (let ([s (pathname-strip-directory filename)])
-	(setarg 0 s (##sys#size s)) )
-      (build-exec-argvec loc (and arglst ($quote-args-list arglst exactf)) setarg 1)
-      (build-exec-argvec loc envlst setenv 0)
-      (##core#inline "C_flushall")
-      (##sys#make-c-string filename loc) ) ) )
-
-(define ($exec-teardown loc msg filename res)
-  (##sys#update-errno)
-  (##core#inline "C_free_exec_args")
-  (##core#inline "C_free_exec_env")
-  (if (fx= res -1)
-      (##sys#error loc msg filename)
-      res ) )
-
-(define (process-execute filename #!optional arglst envlst exactf)
-  (let ([prg ($exec-setup 'process-execute filename arglst envlst exactf)])
-    ($exec-teardown 'process-execute "cannot execute process" filename
-      (if envlst (##core#inline "C_execve" prg) (##core#inline "C_execvp" prg))) ) )
-
-(define (process-spawn mode filename #!optional arglst envlst exactf)
-  (let ([prg ($exec-setup 'process-spawn filename arglst envlst exactf)])
-    ($exec-teardown 'process-spawn "cannot spawn process" filename
-      (if envlst (##core#inline "C_spawnvpe" mode prg) (##core#inline "C_spawnvp" mode prg))) ) )
+(define quote-arg-string
+  (let ((needs-quoting?
+	 ;; This is essentially (string-any char-whitespace? s) but we
+	 ;; don't want a SRFI-13 dependency. (Do we?)
+	 (lambda (s)
+	   (let ((len (string-length s)))
+	     (let loop ((i 0))
+	       (cond
+		((fx= i len) #f)
+		((char-whitespace? (string-ref s i)) #t)
+		(else (loop (fx+ i 1)))) ) )) ))
+    (lambda (str)
+      (if (needs-quoting? str) (string-append "\"" str "\"") str) ) ) )
+
+(define (process-execute filename #!optional (arglist '()) envlist exactf)
+  (let ((argconv (if exactf (lambda (x) x) quote-arg-string)))
+    (call-with-exec-args
+     'process-execute filename argconv arglist envlist
+     (lambda (prg argbuf envbuf)
+       (##core#inline "C_flushall")
+       (let ((r (if envbuf
+		    (##core#inline "C_u_i_execve" prg argbuf envbuf)
+		    (##core#inline "C_u_i_execvp" prg argbuf) )) )
+	 (when (fx= r -1)
+	   (posix-error #:process-error 'process-execute "cannot execute process" filename) ) ) )) ) )
+
+(define (process-spawn mode filename #!optional (arglist '()) envlist exactf)
+  (let ((argconv (if exactf (lambda (x) x) quote-arg-string)))
+    (##sys#check-exact mode 'process-spawn)
+
+    (call-with-exec-args
+     'process-spawn filename argconv arglist envlist
+     (lambda (prg argbuf envbuf)
+       (##core#inline "C_flushall")
+       (let ((r (if envbuf
+		    (##core#inline "C_u_i_spawnvpe" mode prg argbuf envbuf)
+		    (##core#inline "C_u_i_spawnvp" mode prg argbuf) )) )
+	 (when (fx= r -1)
+	   (posix-error #:process-error 'process-spawn "cannot spawn process" filename) ) ) )) ) )
 
 (define-foreign-variable _shlcmd c-string "C_shlcmd")
 
@@ -1277,7 +1215,11 @@
     ; information for the system drives. i.e !C:=...
     ; For now any environment is ignored.
     (lambda (loc cmd args env stdoutf stdinf stderrf #!optional exactf)
-      (let ([cmdlin (string-intersperse ($quote-args-list (cons cmd args) exactf))])
+      (let* ((arglist (cons cmd args))
+	     (cmdlin (string-intersperse
+		      (if exactf
+			  arglist
+			  (map quote-arg-string arglist)))))
 	(let-location ([handle int -1]
 		       [stdin_fd int -1] [stdout_fd int -1] [stderr_fd int -1])
 	  (let ([res