cpet/openbsd-ports
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Update to chicken 4.12.0. From Timo Myyra (MAINTAINER).

Browse Source
This commit is contained in:
juanfra 2017-02-25 02:45:13 +00:00
parent 409ab8be4e
commit 5d15ba9c75
7 changed files with 8 additions and 303 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lang/chicken/Makefile.inc
View File

@ -1,10 +1,9 @@
# $OpenBSD: Makefile.inc,v 1.9 2016/12/18 00:54:22 juanfra Exp $
# $OpenBSD: Makefile.inc,v 1.10 2017/02/25 02:45:13 juanfra Exp $
COMMENT= practical and portable Scheme system
V= 4.11.0
V= 4.12.0
DISTNAME= chicken-${V}
REVISION= 1
MAINTAINER= Timo Myyra <timo.myyra@wickedbsd.net>

4
lang/chicken/bootstrap/distinfo
View File

@ -1,2 +1,2 @@
SHA256 (chicken-4.11.0.tar.gz) = 49wrj5W2o81ZyFtbtr2yvZzvxFtdU2ogytdOPGP0rYk=
SIZE (chicken-4.11.0.tar.gz) = 4201815
SHA256 (chicken-4.12.0.tar.gz) = YFrORZvGboxfgquwPZscnKNvHCKVkx0kTQNimpR6aYk=
SIZE (chicken-4.12.0.tar.gz) = 4240266

6
lang/chicken/core/Makefile
View File

@ -1,8 +1,6 @@
# $OpenBSD: Makefile,v 1.10 2016/12/18 00:54:22 juanfra Exp $
# $OpenBSD: Makefile,v 1.11 2017/02/25 02:45:13 juanfra Exp $
REVISION= 1
SHARED_LIBS= chicken 5.0 # 8
SHARED_LIBS= chicken 5.1 # 8
TEST_TARGET= check
TEST_DEPENDS= ${BUILD_PKGPATH}

4
lang/chicken/core/distinfo
View File

@ -1,2 +1,2 @@
SHA256 (chicken-4.11.0.tar.gz) = 49wrj5W2o81ZyFtbtr2yvZzvxFtdU2ogytdOPGP0rYk=
SIZE (chicken-4.11.0.tar.gz) = 4201815
SHA256 (chicken-4.12.0.tar.gz) = YFrORZvGboxfgquwPZscnKNvHCKVkx0kTQNimpR6aYk=
SIZE (chicken-4.12.0.tar.gz) = 4240266

82
lang/chicken/core/patches/patch-irregex-core_scm
View File

@ -1,82 +0,0 @@
$OpenBSD: patch-irregex-core_scm,v 1.1 2016/12/18 00:54:22 juanfra Exp $
Fix exponential explosion in backtrack compilation (CVE-2016-9954)
http://lists.gnu.org/archive/html/chicken-hackers/2016-12/msg00010.html
--- irregex-core.scm.orig Sat Dec 17 10:34:45 2016
+++ irregex-core.scm Sat Dec 17 10:35:00 2016
@@ -1,6 +1,6 @@
;;;; irregex.scm -- IrRegular Expressions
;;
-;; Copyright (c) 2005-2015 Alex Shinn. All rights reserved.
+;; Copyright (c) 2005-2016 Alex Shinn. All rights reserved.
;; BSD-style license: http://synthcode.com/license.txt
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -30,6 +30,9 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; History
+;; 0.9.6: 2016/12/05 - fixed exponential memory use of + in compilation
+;; of backtracking matcher (CVE-2016-9954).
+;; 0.9.5: 2016/09/10 - fixed a bug in irregex-fold handling of bow
;; 0.9.4: 2015/12/14 - performance improvement for {n,m} matches
;; 0.9.3: 2014/07/01 - R7RS library
;; 0.9.2: 2012/11/29 - fixed a bug in -fold on conditional bos patterns
@@ -3169,16 +3172,7 @@
((sre-empty? (sre-sequence (cdr sre)))
(error "invalid sre: empty *" sre))
(else
- (letrec
- ((body
- (lp (sre-sequence (cdr sre))
- n
- flags
- (lambda (cnk init src str i end matches fail)
- (body cnk init src str i end matches
- (lambda ()
- (next cnk init src str i end matches fail)
- ))))))
+ (let ((body (rec (list '+ (sre-sequence (cdr sre))))))
(lambda (cnk init src str i end matches fail)
(body cnk init src str i end matches
(lambda ()
@@ -3203,10 +3197,21 @@
(lambda ()
(body cnk init src str i end matches fail))))))))
((+)
- (lp (sre-sequence (cdr sre))
- n
- flags
- (rec (list '* (sre-sequence (cdr sre))))))
+ (cond
+ ((sre-empty? (sre-sequence (cdr sre)))
+ (error "invalid sre: empty +" sre))
+ (else
+ (letrec
+ ((body
+ (lp (sre-sequence (cdr sre))
+ n
+ flags
+ (lambda (cnk init src str i end matches fail)
+ (body cnk init src str i end matches
+ (lambda ()
+ (next cnk init src str i end matches fail)
+ ))))))
+ body))))
((=)
(rec `(** ,(cadr sre) ,(cadr sre) ,@(cddr sre))))
((>=)
@@ -3486,11 +3491,10 @@
(fail))))
((bow)
(lambda (cnk init src str i end matches fail)
- (if (and (or (if (> i ((chunker-get-start cnk) src))
- (not (char-alphanumeric? (string-ref str (- i 1))))
- (let ((ch (chunker-prev-char cnk src end)))
- (and ch (not (char-alphanumeric? ch)))))
- (and (eq? src (car init)) (eqv? i (cdr init))))
+ (if (and (if (> i ((chunker-get-start cnk) src))
+ (not (char-alphanumeric? (string-ref str (- i 1))))
+ (let ((ch (chunker-prev-char cnk init src)))
+ (or (not ch) (not (char-alphanumeric? ch)))))
(if (< i end)
(char-alphanumeric? (string-ref str i))

81
lang/chicken/core/patches/patch-posix-common_scm
View File

@ -1,81 +0,0 @@
$OpenBSD: patch-posix-common_scm,v 1.1 2016/08/20 08:56:19 jasper Exp $
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) )))))

129
lang/chicken/core/patches/patch-posixunix_scm
View File

@ -1,129 +0,0 @@
$OpenBSD: patch-posixunix_scm,v 1.1 2016/08/20 08:56:19 jasper Exp $
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")