diff options
Diffstat (limited to 'dev-scheme/chicken/files/4.8.0.5/04_all_CVE-2013-2075_2.patch')
| -rw-r--r-- | dev-scheme/chicken/files/4.8.0.5/04_all_CVE-2013-2075_2.patch | 309 |
1 files changed, 0 insertions, 309 deletions
diff --git a/dev-scheme/chicken/files/4.8.0.5/04_all_CVE-2013-2075_2.patch b/dev-scheme/chicken/files/4.8.0.5/04_all_CVE-2013-2075_2.patch deleted file mode 100644 index b85ea7c8..00000000 --- a/dev-scheme/chicken/files/4.8.0.5/04_all_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) ) ))) |