From 27bafee1bc66235bdff12a9c7de7107c7ba6cec3 Mon Sep 17 00:00:00 2001 From: marting Date: Fri, 14 Jul 2000 16:30:02 +0000 Subject: [PATCH] Shifted receive/send-message to non-blocking sockets. --- scsh/network.scm | 162 ++++++++++++++++++++------------------------ scsh/network1.c | 173 ++++++++++++++++++++++++++++++----------------- scsh/network1.h | 9 +-- 3 files changed, 188 insertions(+), 156 deletions(-) diff --git a/scsh/network.scm b/scsh/network.scm index 5ee3274..680dc90 100644 --- a/scsh/network.scm +++ b/scsh/network.scm @@ -38,7 +38,9 @@ (byte-vector-set! bv 3 (bitwise-and (arithmetic-shift number -24) #xff)) bv)) - +(set! internet-address/any (integer->byte-vector internet-address/any )) +(set! internet-address/loopback (integer->byte-vector internet-address/loopback )) +(set! internet-address/broadcast (integer->byte-vector internet-address/broadcast )) ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ;;; High Level Prototypes ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- @@ -221,13 +223,6 @@ (socket-address:address name))))))) (define-stubless-foreign %bind (sockfd family name) "scheme_bind") -;(define-foreign %bind/errno -; (scheme_bind (fixnum sockfd) ; socket fdes -; (fixnum family) ; address family -; (string-desc name)) ; scheme descriptor -; (to-scheme fixnum errno_or_false)) - -;(define-errno-syscall (%bind sockfd family name) %bind/errno) ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ;;; connect syscall @@ -264,7 +259,7 @@ (define (handle-EINPROGRESS sock) (let ((val (socket-option sock level/socket socket/error))) (if (not (zero? val)) - (errno-error val "scheme_connnect")))) + (errno-error val "scheme_connect")))) (define-stubless-foreign %connect (sockfd family name) "scheme_connect") @@ -296,7 +291,6 @@ (let ((family (socket:family sock))) (let loop () ((structure-ref interrupts disable-interrupts!)) - (display (socket->fdes sock) (current-error-port)) (let ((fd-addr (%accept (socket->fdes sock) family))) (cond ((pair? fd-addr) (let ((fd (car fd-addr)) @@ -420,32 +414,28 @@ (error "receive-message!: integer expected ~s ~s ~s" flags start end)) (else - (generic-receive-message! (socket->fdes socket) flags + (generic-receive-message! socket flags s start end - recv-substring!/errno + recv-substring! (socket:family socket))))))) -(define (generic-receive-message! sockfd flags s start end reader from) +(define (generic-receive-message! socket flags s start end reader family) (if (bogus-substring-spec? s start end) (error "Bad substring indices" - reader sockfd flags - s start end from)) - (let ((addr (make-addr from))) - (let loop ((i start)) - (if (>= i end) (- i start) - (receive (err nread) - (reader sockfd flags s i end addr) - (cond (err (if (= err errno/intr) (loop i) - ;; Give info on partially-read data in error packet. - (errno-error err reader sockfd flags - s start i end addr))) - - ((zero? nread) ; EOF - (values - (let ((result (- i start))) - (and (not (zero? result)) result)) - from)) - (else (loop (+ i nread))))))))) + reader socket flags + s start end family)) + (let loop ((i start) (remote #f)) + (if (>= i end) + (values (- i start) (make-socket-address family remote)) + (let* ((res (reader socket flags s i end))) + (apply (lambda (nread from) + (cond ((zero? nread) ; EOF + (values + (let ((result (- i start))) + (and (not (zero? result)) result)) + (make-socket-address family from))) + (else (loop (+ i nread) from)))) + res))))) (define (receive-message/partial socket len . maybe-flags) (let ((flags (:optional maybe-flags 0))) @@ -475,46 +465,41 @@ (error "receive-message!/partial: integer expected ~s" flags)) (else - (generic-receive-message!/partial (socket->fdes socket) + (generic-receive-message!/partial socket flags s start end - recv-substring!/errno + recv-substring! (socket:family socket))))))) -(define (generic-receive-message!/partial sockfd flags s start end reader from) +(define (generic-receive-message!/partial socket flags s start end reader from) (if (bogus-substring-spec? s start end) (error "Bad substring indices" reader s start end)) (if (= start end) 0 ; Vacuous request. - (let ((addr (make-addr from))) (let loop () - (receive (err nread) - (reader sockfd flags s start end addr) - - (cond ((not err) + (apply (lambda (nread addr) (values (and (not (zero? nread)) nread) - (make-socket-address from addr))) + (make-socket-address from addr))) + (reader socket flags s start end))))) + - ((= err errno/intr) (loop)) - - ; No forward-progess here. - ((or (= err errno/wouldblock) - (= err errno/again)) - 0) - - (else (errno-error err reader sockfd flags - s start start end addr)))))))) - -(define-foreign recv-substring!/errno - (recv_substring (fixnum sockfd) - (fixnum flags) - (string-desc buf) - (size_t start) - (size_t end) - (string-desc name)) - (multi-rep (to-scheme ssize_t errno_or_false) - ssize_t)) +(define (recv-substring! socket flags buf start end) + (let loop () + ((structure-ref interrupts disable-interrupts!)) + (let ((maybe-size-addr + (%recv-substring! (socket->fdes socket) + flags buf start end))) + (cond (maybe-size-addr + ((structure-ref interrupts + enable-interrupts!)) + maybe-size-addr) + (else (wait-for-channel + (fdport-data:channel + (fdport-data (socket:inport socket)))) + (loop)))))) +(define-stubless-foreign %recv-substring! (sockfd flags buf start end) + "recv_substring") ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ;;; send syscall ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- @@ -530,24 +515,19 @@ (else (generic-send-message (socket->fdes socket) flags s start end - send-substring/errno + send-substring (if addr (socket-address:family addr) 0) - (and addr (socket-address:address addr))))))) + (if addr (socket-address:address addr) #f)))))) (define (generic-send-message sockfd flags s start end writer family addr) (if (bogus-substring-spec? s start end) (error "Bad substring indices" sockfd flags family addr s start end writer)) - (let ((addr (if addr (make-addr family) ""))) + (let loop ((i start)) (if (< i end) - (receive (err nwritten) - (writer sockfd flags s i end family addr) - (cond ((not err) (loop (+ i nwritten))) - ((= err errno/intr) (loop i)) - (else (errno-error err sockfd flags family addr - s start i end writer)))))))) + (loop (+ i (writer sockfd flags s i end family addr)))))) (define (send-message/partial socket s . args) @@ -561,36 +541,38 @@ (else (generic-send-message/partial (socket->fdes socket) flags s start end - send-substring/errno + send-substring (if addr (socket-address:family addr) 0) - (if addr (socket-address:address addr))))))) + (if addr + (socket-address:address addr) + #f)))))) -(define (generic-send-message/partial sockfd flags s start end writer family addr) +(define (generic-send-message/partial sockfd flags s start end writer family + addr) (if (bogus-substring-spec? s start end) (error "Bad substring indices" sockfd flags family addr s start end writer)) + (if (= start end) + 0 ; Vacuous request. + (writer sockfd flags s start end family addr))) - (if (= start end) 0 ; Vacuous request. - (let loop () - (receive (err nwritten) - (writer sockfd flags s start end family addr) - (cond ((not err) nwritten) - ((= err errno/intr) (loop)) - ((or (= err errno/again) (= err errno/wouldblock)) 0) - (else (errno-error err sockfd flags family addr - s start start end writer))))))) +(define (send-substring sockfd flags buf start end family name) + (let loop () + ((structure-ref interrupts disable-interrupts!)) + (cond ((%send-substring sockfd flags buf start end family name) + => (lambda (nwritten) + ((structure-ref interrupts + enable-interrupts!)) + nwritten)) + (else (wait-for-channel + (fdport-data:channel + (fdport-data (socket:inport socket)))) + (loop))))) -(define-foreign send-substring/errno - (send_substring (fixnum sockfd) - (fixnum flags) - (string-desc buf) - (size_t start) - (size_t end) - (fixnum family) - (string-desc name)) - (multi-rep (to-scheme ssize_t errno_or_false) - ssize_t)) +(define-stubless-foreign + %send-substring (sockfd flags buf start end family name) + "send_substring") ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ;;; getsockopt syscall diff --git a/scsh/network1.c b/scsh/network1.c index 0b20a5a..d00fddc 100644 --- a/scsh/network1.c +++ b/scsh/network1.c @@ -22,6 +22,12 @@ #include "scheme48.h" //extern int h_errno; +/* to extract a 4 byte long value from a scheme string */ + +#define GET_LONG(x,n) (*((u_long *)(S48_ADDRESS_AFTER_HEADER((x),unsigned char)+(n*4)))) + +#define SET_LONG(x,n,v) GET_LONG((x),(n))=(u_long)(v); + s48_value long2byte_vector (long number) { s48_value bv = s48_make_byte_vector (4, 0); @@ -278,64 +284,59 @@ int scheme_socket_pair(int type, int *s1, int *s2) } /*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/ -ssize_t recv_substring(int s, - int flags, - s48_value buf, - size_t start, - size_t end, - s48_value scheme_name) +s48_value +recv_substring(s48_value scm_sockfd, s48_value flags, s48_value buf, + s48_value scm_start, s48_value scm_end) { - - switch(S48_STRING_LENGTH(scheme_name)) - { -#ifdef NOTUSED -/* no longer used. always return remote socket info */ - case 0: /* only with connected sockets */ - { - return recv(s, StrByte(buf,start), end-start, flags); - } -#endif - case 8: /* AF_INET */ - { - struct sockaddr_in name; - int namelen=sizeof(name); - int cc=recvfrom(s, - StrByte(buf,start), end-start, - flags, - (struct sockaddr *)&name, &namelen); - s48_value result; - S48_DECLARE_GC_PROTECT(1); - if (cc < 0) s48_raise_os_error (errno); - - result = make_addr (name.sin_addr.s_addr, - htonl((u_long)ntohs(name.sin_port))); - S48_GC_PROTECT_1 (result); - - result = (s48_cons (s48_enter_fixnum (cc), result)); - S48_GC_UNPROTECT(); - return result; - break; - } - default: - s48_raise_argtype_error (s48_enter_fixnum (-1)); /* error unknown address family */ - } + struct sockaddr_in name; + int namelen=sizeof(name); + int sockfd = s48_extract_fixnum (scm_sockfd); + int start = s48_extract_fixnum (scm_start); + int end = s48_extract_fixnum (scm_end); + char* buf_part = s48_extract_string (buf) + start; + + int cc=recvfrom(sockfd, + buf_part, end-start, + s48_extract_fixnum (flags), + (struct sockaddr *)&name, &namelen); + s48_value result; + + if (cc >= 0) + return (s48_cons (s48_enter_fixnum (cc), + s48_cons (make_addr (name.sin_addr.s_addr, + htonl((u_long)ntohs(name.sin_port))), + S48_NULL))); + + + if ((errno != EWOULDBLOCK) && (errno != EINTR) && (errno != EAGAIN)) + s48_raise_os_error(errno); + if (! s48_add_pending_fd(sockfd, 1))// 1 for is_input + s48_raise_out_of_memory_error(); + return S48_FALSE; } /*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/ -ssize_t send_substring(int s, - int flags, - s48_value buf, - size_t start, - size_t end, - int family, - s48_value scheme_name) +s48_value send_substring(s48_value scm_sockfd, + s48_value scm_flags, + s48_value buf, + s48_value scm_start, + s48_value scm_end, + s48_value scm_family, + s48_value scheme_name) { - - switch(family) + int n; + int s = s48_extract_fixnum (scm_sockfd); + int flags = s48_extract_fixnum (scm_flags); + int start = s48_extract_fixnum (scm_start); + int end = s48_extract_fixnum (scm_end); + char* buf_part = s48_extract_string (buf) + start; + + switch(s48_extract_fixnum (scm_family)) { case 0: /* only with connected sockets */ { - return send(s, StrByte(buf,start), end-start, flags); + n = send(s, buf_part, end-start, flags); + break; } case AF_UNIX: { @@ -349,31 +350,45 @@ ssize_t send_substring(int s, s48_extract_string(scheme_name), scheme_length); /* copy to c string */ name.sun_path[scheme_length]='\0'; /* add null */ - return(sendto(s, - StrByte(buf,start), end-start, - flags, - (struct sockaddr *)&name, sizeof(name))); + n = sendto(s, + buf_part, end-start, + flags, + (struct sockaddr *)&name, sizeof(name)); break; } case AF_INET: { struct sockaddr_in name; - u_long addr=GET_LONG(scheme_name,0); - u_short port=htons((u_short)ntohl(GET_LONG(scheme_name,1))); + u_long addr = htonl (byte_vector2long (S48_CAR (scheme_name))); + u_short port = htons(s48_extract_fixnum (S48_CDR (scheme_name))); name.sin_family=AF_INET; name.sin_addr.s_addr=addr; name.sin_port=port; - return(sendto(s, - StrByte(buf,start), end-start, - flags, - (struct sockaddr *)&name, sizeof(name))); - break; + n = sendto(s, + buf_part, end-start, + flags, + (struct sockaddr *)&name, sizeof(name)); + break; } default: - s48_raise_argtype_error (family); /* error unknown address family */ + s48_raise_argtype_error (s48_extract_fixnum (scm_family)); + /* error unknown address family */ } + + if (n >= 0) + return s48_enter_fixnum (n); + + if ((errno != EWOULDBLOCK) && (errno != EINTR) && (errno != EAGAIN)) + s48_raise_os_error(errno); + + if (! s48_add_pending_fd(s, 0))// 0 for is_input + s48_raise_out_of_memory_error(); + + return S48_FALSE; } + + /*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/ int scheme_getsockopt (int s, @@ -742,4 +757,38 @@ s48_value scheme_proto_name2proto_info(s48_value in_name) } +/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/ +/* Low Level Junk */ +/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/ +/* svec is a Scheme vector of C carriers. Scan over the C longs +** in cvec, and initialise the corresponding carriers in svec. +*/ +void set_longvec_carriers(s48_value svec, long const * const * cvec) +{ + int svec_len = S48_VECTOR_LENGTH(svec); + long const * const *cv = cvec; + s48_value s = S48_VECTOR_REF(svec,0); //JMG hack + s48_value *sv = &s; + + for(; svec_len > 0; cv++, sv++, svec_len-- ) { + /* *sv is a (make-string 4) */ + s48_value carrier = *sv; + (*((u_long *)(S48_ADDRESS_AFTER_HEADER(carrier,unsigned char)))) + =(long)**cv; + } +} + +/* One arg, a zero-terminated C word vec. Returns length. +** The terminating null is not counted. Returns #f on NULL. +*/ + +s48_value veclen(const long *vec) +{ + const long *vptr = vec; + if( !vptr ) return S48_FALSE; + while( *vptr ) vptr++; + return s48_enter_fixnum(vptr - vec); +} + + diff --git a/scsh/network1.h b/scsh/network1.h index e14a3fc..fc9ce7e 100644 --- a/scsh/network1.h +++ b/scsh/network1.h @@ -13,11 +13,12 @@ s48_value scheme_socket_name(s48_value sockfd, s48_value family); int scheme_socket_pair(int type, int *s1, int *s2); -ssize_t recv_substring(int s, int flags, s48_value buf, - size_t start, size_t end, s48_value scheme_name); +s48_value recv_substring(s48_value s, s48_value flags, s48_value buf, + s48_value start, s48_value end); -ssize_t send_substring(int s, int flags, s48_value buf, size_t start, size_t end, - int family, s48_value scheme_name); +s48_value send_substring(s48_value s, s48_value flags, s48_value buf, + s48_value start, s48_value end, s48_value family, + s48_value scheme_name); int scheme_getsockopt (int s, int level, int optname);