Get Gentoo!
gentoo.org sites
gentoo.org Wiki Bugs Forums Packages
Planet Archives Sources
Infra Status
summaryrefslogtreecommitdiff
path: root/dev-scheme/chicken/files/chicken-4.8.0.3-CVE-2013-2075_2.patch
diff options
context:
space:
mode:
Diffstat (limited to 'dev-scheme/chicken/files/chicken-4.8.0.3-CVE-2013-2075_2.patch')
-rw-r--r--dev-scheme/chicken/files/chicken-4.8.0.3-CVE-2013-2075_2.patch309
1 files changed, 0 insertions, 309 deletions
diff --git a/dev-scheme/chicken/files/chicken-4.8.0.3-CVE-2013-2075_2.patch b/dev-scheme/chicken/files/chicken-4.8.0.3-CVE-2013-2075_2.patch
deleted file mode 100644
index b85ea7c8b259..000000000000
--- a/dev-scheme/chicken/files/chicken-4.8.0.3-CVE-2013-2075_2.patch
+++ /dev/null
@@ -1,309 +0,0 @@
-From http://code.call-cc.org/cgi-bin/gitweb.cgi?p=chicken-core.git;a=commitdiff;h=556108092774086b6c86c2e27daf3f740ffec091
-
---- chicken-4.8.0.3/chicken.h
-+++ chicken-4.8.0.3/chicken.h
-@@ -1668,6 +1668,7 @@
- C_fctexport C_word C_fcall C_read_char(C_word port) C_regparm;
- C_fctexport C_word C_fcall C_peek_char(C_word port) C_regparm;
- C_fctexport C_word C_fcall C_execute_shell_command(C_word string) C_regparm;
-+C_fctexport int C_fcall C_check_fd_ready(int fd) C_regparm;
- C_fctexport C_word C_fcall C_char_ready_p(C_word port) C_regparm;
- C_fctexport C_word C_fcall C_fudge(C_word fudge_factor) C_regparm;
- C_fctexport void C_fcall C_raise_interrupt(int reason) C_regparm;
---- chicken-4.8.0.3/posixunix.scm
-+++ chicken-4.8.0.3/posixunix.scm
-@@ -493,16 +493,7 @@
- "if(val == -1) C_return(0);"
- "C_return(fcntl(fd, F_SETFL, val | O_NONBLOCK) != -1);" ) )
-
--(define ##sys#file-select-one
-- (foreign-lambda* int ([int fd])
-- "fd_set in;"
-- "struct timeval tm;"
-- "FD_ZERO(&in);"
-- "FD_SET(fd, &in);"
-- "tm.tv_sec = tm.tv_usec = 0;"
-- "if(select(fd + 1, &in, NULL, NULL, &tm) == -1) C_return(-1);"
-- "else C_return(FD_ISSET(fd, &in) ? 1 : 0);" ) )
--
-+(define ##sys#file-select-one (foreign-lambda int "C_check_fd_ready" int) )
-
- ;;; Lo-level I/O:
-
---- chicken-4.8.0.3/runtime.c
-+++ chicken-4.8.0.3/runtime.c
-@@ -60,6 +60,11 @@
- # define EOVERFLOW 0
- #endif
-
-+/* TODO: Include sys/select.h? Windows doesn't seem to have it... */
-+#ifdef HAVE_POSIX_POLL
-+# include <poll.h>
-+#endif
-+
- #if !defined(C_NONUNIX)
-
- # include <sys/types.h>
-@@ -4036,20 +4041,39 @@
- return C_fix(n);
- }
-
-+/*
-+ * TODO: Implement something for Windows that supports selecting on
-+ * arbitrary fds (there, select() only works on network sockets and
-+ * poll() is not available at all).
-+ */
-+C_regparm int C_fcall C_check_fd_ready(int fd)
-+{
-+#ifdef HAVE_POSIX_POLL
-+ struct pollfd ps;
-+ ps.fd = fd;
-+ ps.events = POLLIN;
-+ return poll(&ps, 1, 0);
-+#else
-+ fd_set in;
-+ struct timeval tm;
-+ int rv;
-+ FD_ZERO(&in);
-+ FD_SET(fd, &in);
-+ tm.tv_sec = tm.tv_usec = 0;
-+ rv = select(fd + 1, &in, NULL, NULL, &tm);
-+ if(rv > 0) { rv = FD_ISSET(fd, &in) ? 1 : 0; }
-+ return rv;
-+#endif
-+}
-
- C_regparm C_word C_fcall C_char_ready_p(C_word port)
- {
--#if !defined(C_NONUNIX)
-- fd_set fs;
-- struct timeval to;
-- int fd = C_fileno(C_port_file(port));
--
-- FD_ZERO(&fs);
-- FD_SET(fd, &fs);
-- to.tv_sec = to.tv_usec = 0;
-- return C_mk_bool(C_select(fd + 1, &fs, NULL, NULL, &to) == 1);
--#else
-+#if defined(C_NONUNIX)
-+ /* The best we can currently do on Windows... */
- return C_SCHEME_TRUE;
-+#else
-+ int fd = C_fileno(C_port_file(port));
-+ return C_mk_bool(C_check_fd_ready(fd) == 1);
- #endif
- }
-
---- chicken-4.8.0.3/tcp.scm
-+++ chicken-4.8.0.3/tcp.scm
-@@ -46,6 +46,7 @@
- # define fcntl(a, b, c) 0
- # define EWOULDBLOCK 0
- # define EINPROGRESS 0
-+# define EAGAIN 0
- # define typecorrect_getsockopt(socket, level, optname, optval, optlen) \
- getsockopt(socket, level, optname, (char *)optval, optlen)
- #else
-@@ -111,6 +112,7 @@
- (define ##net#recv (foreign-lambda int "recv" int scheme-pointer int int))
- (define ##net#shutdown (foreign-lambda int "shutdown" int int))
- (define ##net#connect (foreign-lambda int "connect" int scheme-pointer int))
-+(define ##net#check-fd-ready (foreign-lambda int "C_check_fd_ready" int))
-
- (define ##net#send
- (foreign-lambda*
-@@ -177,30 +179,6 @@
- if((se = getservbyname(serv, proto)) == NULL) C_return(0);
- else C_return(ntohs(se->s_port));") )
-
--(define ##net#select
-- (foreign-lambda* int ((int fd))
-- "fd_set in;
-- struct timeval tm;
-- int rv;
-- FD_ZERO(&in);
-- FD_SET(fd, &in);
-- tm.tv_sec = tm.tv_usec = 0;
-- rv = select(fd + 1, &in, NULL, NULL, &tm);
-- if(rv > 0) { rv = FD_ISSET(fd, &in) ? 1 : 0; }
-- C_return(rv);") )
--
--(define ##net#select-write
-- (foreign-lambda* int ((int fd))
-- "fd_set out;
-- struct timeval tm;
-- int rv;
-- FD_ZERO(&out);
-- FD_SET(fd, &out);
-- tm.tv_sec = tm.tv_usec = 0;
-- rv = select(fd + 1, NULL, &out, NULL, &tm);
-- if(rv > 0) { rv = FD_ISSET(fd, &out) ? 1 : 0; }
-- C_return(rv);") )
--
- (define ##net#gethostaddr
- (foreign-lambda* bool ((scheme-pointer saddr) (c-string host) (unsigned-short port))
- "struct hostent *he = gethostbyname(host);"
-@@ -212,13 +190,6 @@
- "addr->sin_addr = *((struct in_addr *)he->h_addr);"
- "C_return(1);") )
-
--(define (yield)
-- (##sys#call-with-current-continuation
-- (lambda (return)
-- (let ((ct ##sys#current-thread))
-- (##sys#setslot ct 1 (lambda () (return (##core#undefined))))
-- (##sys#schedule) ) ) ) )
--
- (define ##net#parse-host
- (let ((substring substring))
- (lambda (host proto)
-@@ -343,7 +314,9 @@
- (outbufsize (tbs))
- (outbuf (and outbufsize (fx> outbufsize 0) ""))
- (tmr (tcp-read-timeout))
-+ (dlr (and tmr (+ (current-milliseconds) tmr)))
- (tmw (tcp-write-timeout))
-+ (dlw (and tmw (+ (current-milliseconds) tmw)))
- (read-input
- (lambda ()
- (let loop ()
-@@ -351,12 +324,11 @@
- (cond ((eq? -1 n)
- (cond ((or (eq? errno _ewouldblock)
- (eq? errno _eagain))
-- (when tmr
-- (##sys#thread-block-for-timeout!
-- ##sys#current-thread
-- (+ (current-milliseconds) tmr) ) )
-+ (when dlr
-+ (##sys#thread-block-for-timeout!
-+ ##sys#current-thread dlr) )
- (##sys#thread-block-for-i/o! ##sys#current-thread fd #:input)
-- (yield)
-+ (##sys#thread-yield!)
- (when (##sys#slot ##sys#current-thread 13)
- (##sys#signal-hook
- #:network-timeout-error
-@@ -386,7 +358,7 @@
- c) ) )
- (lambda ()
- (or (fx< bufindex buflen)
-- (let ((f (##net#select fd)))
-+ (let ((f (##net#check-fd-ready fd)))
- (when (eq? f -1)
- (##sys#update-errno)
- (##sys#signal-hook
-@@ -469,12 +441,11 @@
- (cond ((eq? -1 n)
- (cond ((or (eq? errno _ewouldblock)
- (eq? errno _eagain))
-- (when tmw
-+ (when dlw
- (##sys#thread-block-for-timeout!
-- ##sys#current-thread
-- (+ (current-milliseconds) tmw) ) )
-- (##sys#thread-block-for-i/o! ##sys#current-thread fd #:output)
-- (yield)
-+ ##sys#current-thread dlw) )
-+ (##sys#thread-block-for-i/o! ##sys#current-thread fd #:output)
-+ (##sys#thread-yield!)
- (when (##sys#slot ##sys#current-thread 13)
- (##sys#signal-hook
- #:network-timeout-error
-@@ -528,38 +499,29 @@
-
- (define (tcp-accept tcpl)
- (##sys#check-structure tcpl 'tcp-listener)
-- (let ((fd (##sys#slot tcpl 1))
-- (tma (tcp-accept-timeout)))
-+ (let* ((fd (##sys#slot tcpl 1))
-+ (tma (tcp-accept-timeout))
-+ (dla (and tma (+ tma (current-milliseconds)))))
- (let loop ()
-- (if (eq? 1 (##net#select fd))
-- (let ((fd (##net#accept fd #f #f)))
-- (cond ((not (eq? -1 fd)) (##net#io-ports fd))
-- ((eq? errno _eintr)
-- (##sys#dispatch-interrupt loop))
-- (else
-- (##sys#update-errno)
-- (##sys#signal-hook
-- #:network-error
-- 'tcp-accept
-- (##sys#string-append "could not accept from listener - " strerror)
-- tcpl))))
-- (begin
-- (when tma
-- (##sys#thread-block-for-timeout!
-- ##sys#current-thread
-- (+ (current-milliseconds) tma) ) )
-- (##sys#thread-block-for-i/o! ##sys#current-thread fd #:input)
-- (yield)
-- (when (##sys#slot ##sys#current-thread 13)
-- (##sys#signal-hook
-- #:network-timeout-error
-- 'tcp-accept
-- "accept operation timed out" tma fd) )
-- (loop) ) ) ) ) )
-+ (when dla
-+ (##sys#thread-block-for-timeout! ##sys#current-thread dla) )
-+ (##sys#thread-block-for-i/o! ##sys#current-thread fd #:input)
-+ (##sys#thread-yield!)
-+ (if (##sys#slot ##sys#current-thread 13)
-+ (##sys#signal-hook
-+ #:network-timeout-error
-+ 'tcp-accept
-+ "accept operation timed out" tma fd) )
-+ (let ((fd (##net#accept fd #f #f)))
-+ (cond ((not (eq? -1 fd)) (##net#io-ports fd))
-+ ((eq? errno _eintr)
-+ (##sys#dispatch-interrupt loop))
-+ (else
-+ (network-error 'tcp-accept "could not accept from listener" tcpl)))) ) ) )
-
- (define (tcp-accept-ready? tcpl)
- (##sys#check-structure tcpl 'tcp-listener 'tcp-accept-ready?)
-- (let ((f (##net#select (##sys#slot tcpl 1))))
-+ (let ((f (##net#check-fd-ready (##sys#slot tcpl 1))))
- (when (eq? -1 f)
- (##sys#update-errno)
- (##sys#signal-hook
-@@ -578,8 +540,9 @@
- (define general-strerror (foreign-lambda c-string "strerror" int))
-
- (define (tcp-connect host . more)
-- (let ((port (optional more #f))
-- (tmc (tcp-connect-timeout)))
-+ (let* ((port (optional more #f))
-+ (tmc (tcp-connect-timeout))
-+ (dlc (and tmc (+ (current-milliseconds) tmc))))
- (##sys#check-string host)
- (unless port
- (set!-values (host port) (##net#parse-host host "tcp"))
-@@ -606,23 +569,9 @@
- (let loop ()
- (when (eq? -1 (##net#connect s addr _sockaddr_in_size))
- (cond ((eq? errno _einprogress)
-- (let loop2 ()
-- (let ((f (##net#select-write s)))
-- (when (eq? f -1) (fail))
-- (unless (eq? f 1)
-- (when tmc
-- (##sys#thread-block-for-timeout!
-- ##sys#current-thread
-- (+ (current-milliseconds) tmc) ) )
-- (##sys#thread-block-for-i/o! ##sys#current-thread s #:all)
-- (yield)
-- (when (##sys#slot ##sys#current-thread 13)
-- (##net#close s)
-- (##sys#signal-hook
-- #:network-timeout-error
-- 'tcp-connect
-- "connect operation timed out" tmc s) )
-- (loop2) ) ) ))
-+ (when dlc
-+ (##sys#thread-block-for-timeout! ##sys#current-thread dlc))
-+ (##sys#thread-block-for-i/o! ##sys#current-thread s #:all))
- ((eq? errno _eintr)
- (##sys#dispatch-interrupt loop))
- (else (fail) ) )))