Hi,
Here's an security fix for chicken 4.11.0 fixing CVE-2016-6830 and
CVE-2016-6831. The patch is a bit large.
While here I dropped the patched test file, its not really needed so we could
drop it.
Timo
Index: Makefile.inc
===================================================================
RCS file: /cvs/ports/lang/chicken/Makefile.inc,v
retrieving revision 1.7
diff -u -u -p -r1.7 Makefile.inc
--- Makefile.inc 8 Jun 2016 01:24:45 -0000 1.7
+++ Makefile.inc 20 Aug 2016 05:15:06 -0000
@@ -4,6 +4,7 @@ COMMENT= practical and portable Scheme s
V= 4.11.0
DISTNAME= chicken-${V}
+REVISION= 0
MAINTAINER= Timo Myyra <timo.my...@wickedbsd.net>
@@ -32,4 +33,3 @@ pre-build:
.if ${MACHINE_ARCH} == "hppa"
sed -i 's/C_STACK_GROWS_DOWNWARD 1/C_STACK_GROWS_DOWNWARD 0/g'
"${WRKSRC}/Makefile.bsd"
.endif
-
Index: core/patches/patch-csc_scm
===================================================================
RCS file: /cvs/ports/lang/chicken/core/patches/patch-csc_scm,v
retrieving revision 1.3
diff -u -u -p -r1.3 patch-csc_scm
--- core/patches/patch-csc_scm 27 Aug 2015 22:40:33 -0000 1.3
+++ core/patches/patch-csc_scm 20 Aug 2016 05:15:06 -0000
@@ -1,7 +1,7 @@
$OpenBSD: patch-csc_scm,v 1.3 2015/08/27 22:40:33 juanfra Exp $
---- csc.scm.orig Tue Aug 4 21:46:22 2015
-+++ csc.scm Thu Aug 27 19:07:56 2015
-@@ -981,9 +981,7 @@ EOF
+--- csc.scm.orig Sat May 28 14:48:08 2016
++++ csc.scm Mon Aug 15 07:51:43 2016
+@@ -990,9 +990,7 @@ EOF
dynamic-libchicken
(cond (osx "dylib")
((or mingw cygwin) "dll")
Index: core/patches/patch-posix-common_scm
===================================================================
RCS file: core/patches/patch-posix-common_scm
diff -N core/patches/patch-posix-common_scm
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ core/patches/patch-posix-common_scm 20 Aug 2016 05:15:06 -0000
@@ -0,0 +1,81 @@
+$OpenBSD$
+fix buffer overflow and mem leak in execvp/execve wrappers
+see CVE-2016-6830 and CVE-2016-6831.
+--- posix-common.scm.orig Mon Aug 15 16:24:59 2016
++++ posix-common.scm Mon Aug 15 16:30:27 2016
+@@ -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 @@ EOF
+ (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) )))))
Index: core/patches/patch-posixunix_scm
===================================================================
RCS file: core/patches/patch-posixunix_scm
diff -N core/patches/patch-posixunix_scm
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ core/patches/patch-posixunix_scm 20 Aug 2016 05:15:06 -0000
@@ -0,0 +1,129 @@
+$OpenBSD$
+fix buffer overflow and mem leak in execvp/execve wrappers
+see CVE-2016-6830 and CVE-2016-6831.
+
+--- posixunix.scm.orig Sat May 28 14:48:08 2016
++++ posixunix.scm Mon Aug 15 16:32:17 2016
+@@ -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 @@ static C_TLS int C_wait_status;
+ # 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 @@ extern char **environ;
+ # 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,30 +189,9 @@ static C_TLS struct stat C_statbuf;
+
+ #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;
+-}
++#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)))
+
+-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))
+-
+ #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;
+ # define C_WIFEXITED(n) (C_uw = C_unfix(n), C_mk_bool(WIFEXITED(C_uw)))
+@@ -1591,43 +1560,15 @@ EOF
+ (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")
Index: core/patches/patch-tests_data-structures-tests_scm
===================================================================
RCS file: core/patches/patch-tests_data-structures-tests_scm
diff -N core/patches/patch-tests_data-structures-tests_scm
--- core/patches/patch-tests_data-structures-tests_scm 16 Jun 2015 14:45:04
-0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,45 +0,0 @@
-$OpenBSD: patch-tests_data-structures-tests_scm,v 1.2 2015/06/16 14:45:04
jasper Exp $
-
-Security fix for CVE-2014-9651
-http://lists.nongnu.org/archive/html/chicken-hackers/2014-12/msg00000.html
-
-Security fix for CVE-2015-4556
-http://lists.nongnu.org/archive/html/chicken-hackers/2015-06/msg00037.html
-
---- tests/data-structures-tests.scm.orig Tue Jun 16 10:11:45 2015
-+++ tests/data-structures-tests.scm Tue Jun 16 10:11:37 2015
-@@ -1,6 +1,6 @@
- ;;;; data-structures-tests.scm
-
--(use data-structures)
-+(use data-structures lolevel)
-
- (define-syntax assert-error
- (syntax-rules ()
-@@ -42,6 +42,26 @@
- (assert (> 0 (string-compare3-ci "foo\x00A" "foo\x00b")))
- (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))))
-+
-+(assert (string=? "bde" (string-translate* "abcd"
-+ '(("a" . "b")
-+ ("b" . "")
-+ ("c" . "d")
-+ ("d" . "e")))))
-+(assert (string=? "bc" (string-translate* "abc"
-+ '(("ab" . "b")
-+ ("bc" . "WRONG")))))
-+(assert (string=? "x" (string-translate* "ab" '(("ab" . "x")))))
-+(assert (string=? "xy" (string-translate* "xyz" '(("z" . "")))))
-
- ;; topological-sort
-
