>From 670a3edac727167fd52ddd52275735fbc0d075de Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Wed, 27 Mar 2013 00:09:14 +0100 Subject: [PATCH 1/3] Replace select() by poll() when available, in char-ready? and tcp-accept-ready? Also, timeout values in tcp-accept and tcp-connect, and in the TCP port read and write procedures are now honored more strictly by calculating the wait time at the start instead of after each interrupted system call. It was pointed out by Florian Zumbiehl that select() was still being used in a few places, and Joerg Wittenberger provided an initial patch to remove select() from the TCP unit. --- NEWS | 2 + chicken.h | 1 + posixunix.scm | 11 +---- runtime.c | 44 +++++++++++++++----- tcp.scm | 126 +++++++++++++++++++--------------------------------------- 5 files changed, 78 insertions(+), 106 deletions(-) diff --git a/NEWS b/NEWS index b013a84..fb75f53 100644 --- a/NEWS +++ b/NEWS @@ -4,6 +4,8 @@ - CVE-2013-1874: ./.csirc is no longer loaded from the current directory upon startup of csi, which could lead to untrusted code execution. (thanks to Florian Zumbiehl) + - Use POSIX poll() in other places where select() was still being used. + (thanks to Florian Zumbiehl and Joerg Wittenberger) - Tools - csc: added "-oi"/"-ot" options as alternatives to "-emit-inline-file" diff --git a/chicken.h b/chicken.h index 2b9030a..53553c5 100644 --- a/chicken.h +++ b/chicken.h @@ -1730,6 +1730,7 @@ C_fctexport C_word C_fcall C_get_print_precision(void) C_regparm; 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; diff --git a/posixunix.scm b/posixunix.scm index 15cb535..b72ee52 100644 --- a/posixunix.scm +++ b/posixunix.scm @@ -501,16 +501,7 @@ EOF "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: diff --git a/runtime.c b/runtime.c index 099dbdc..5ce267e 100644 --- a/runtime.c +++ b/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 +#endif + #if !defined(C_NONUNIX) # include @@ -4174,20 +4179,39 @@ C_regparm C_word C_fcall C_execute_shell_command(C_word string) 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 } diff --git a/tcp.scm b/tcp.scm index db713bb..7e37721 100644 --- a/tcp.scm +++ b/tcp.scm @@ -50,6 +50,9 @@ static WSADATA wsa; # ifndef EINPROGRESS # define EINPROGRESS 0 # endif +# ifndef EAGAIN +# define EAGAIN 0 +# endif # define typecorrect_getsockopt(socket, level, optname, optval, optlen) \ getsockopt(socket, level, optname, (char *)optval, optlen) #else @@ -115,6 +118,7 @@ EOF (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* @@ -181,30 +185,6 @@ EOF 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);" @@ -216,13 +196,6 @@ EOF "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-syntax network-error (syntax-rules () ((_ loc msg . args) @@ -342,7 +315,9 @@ EOF (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 () @@ -350,12 +325,11 @@ EOF (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 @@ -381,7 +355,7 @@ EOF c) ) ) (lambda () (or (fx< bufindex buflen) - (let ((f (##net#select fd))) + (let ((f (##net#check-fd-ready fd))) (when (eq? f -1) (network-error #f "cannot check socket for input" fd) ) (eq? f 1) ) ) ) @@ -452,12 +426,11 @@ EOF (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 @@ -505,33 +478,29 @@ EOF (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 - (network-error 'tcp-accept "could not accept from listener" 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) (network-error 'tcp-accept-ready? "cannot check socket for input" tcpl) ) (eq? 1 f) ) ) @@ -547,8 +516,9 @@ EOF (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")) @@ -565,25 +535,9 @@ EOF (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) - (##net#close s) - (network-error 'tcp-connect "cannot connect to socket" host port)) - (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 -- 1.8.0.1