suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Allow binding to ephemeral ports

Browse Source 
svn: r16382
This commit is contained in:
Kevin Tew 2009-10-20 17:00:20 +00:00
parent c981441729
commit ac7853dc00
7 changed files with 288 additions and 182 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/scheme/tcp.ss
View File

@ -1,6 +1,7 @@
(module tcp '#%kernel
(#%require '#%network)
(#%require (all-except '#%network tcp-addresses)
(rename '#%network c:tcp-addresses tcp-addresses))
(#%provide tcp-connect
tcp-connect/enable-break
@ -13,4 +14,15 @@
tcp-listener?
tcp-addresses
tcp-abandon-port
tcp-port?))
tcp-port?)
(define-values (tcp-addresses)
(case-lambda
[(socket) (tcp-addresses socket #f)]
[(socket port-numbers?)
(if (tcp-port? socket)
(c:tcp-addresses socket port-numbers?)
(if (tcp-listener? socket)
(c:tcp-addresses socket port-numbers?)
(raise-type-error 'tcp-addresses "tcp-port or tcp-listener" socket)))])))

11
collects/scheme/udp.ss
View File

@ -22,4 +22,13 @@
udp-send-ready-evt
udp-receive!-evt
udp-send-evt
udp-send-to-evt))
udp-send-to-evt
udp-addresses)
(define-values (udp-addresses)
(case-lambda
[(x) (udp-addresses x #f)]
[(socket port-numbers?)
(if (udp? socket)
(tcp-addresses socket port-numbers?)
(raise-type-error 'udp-addresses "udp socket" socket))])))

36
collects/scribblings/reference/networking.scrbl
View File

@ -14,14 +14,16 @@ For information about TCP in general, see @italic{TCP/IP Illustrated,
Volume 1} by W. Richard Stevens.
@defproc[(tcp-listen [port-no (and/c exact-nonnegative-integer?
(integer-in 1 65535))]
(integer-in 0 65535))]
[max-allow-wait exact-nonnegative-integer? 4]
[reuse? any/c #f]
[hostname (or/c string? #f) #f])
tcp-listener?]
Creates a ``listening'' server on the local machine at the port number
specified by @scheme[port-no]. The @scheme[max-allow-wait] argument
specified by @scheme[port-no]. If @scheme[port-no] is 0 the socket binds
to an ephemeral port, which can be determined by calling
@scheme[tcp-addresses]. The @scheme[max-allow-wait] argument
determines the maximum number of client connections that can be
waiting for acceptance. (When @scheme[max-allow-wait] clients are
waiting acceptance, no new client connections can be made.)
@ -222,7 +224,7 @@ connections, so @scheme[tcp-abandon-port] is equivalent to
@scheme[close-input-port] on input @tech{TCP ports}.}
@defproc[(tcp-addresses [tcp-port tcp-port?]
@defproc[(tcp-addresses [tcp-port (or/c tcp-port? tcp-listener?)]
[port-numbers? any/c #f])
(or/c (values string? string?)
(values string? (integer-in 1 65535)
@ -283,11 +285,13 @@ non-@scheme[#f], then the socket's protocol family is IPv4.}
@defproc[(udp-bind! [udp-socket udp?]
[hostname-string (or/c string? #f)]
[port-no (and/c exact-nonnegative-integer?
(integer-in 1 65535))])
(integer-in 0 65535))])
void?]{
Binds an unbound @scheme[udp-socket] to the local port number
@scheme[port-no].
@scheme[port-no]. If @scheme[port-no] is 0 the @scheme[udp-socket] is
bound to an ephemeral port, which can be determined by calling
@scheme[udp-addresses].
If @scheme[hostname-string] is @scheme[#f], then the socket
accepts connections to all of the listening machine's IP
@ -560,3 +564,25 @@ bytes start-pos end-pos)], and the synchronization result is a list of
three values, corresponding to the three results from
@scheme[udp-receive!]. (No bytes are received and the @scheme[bstr]
content is not modified if the event is not chosen.)}
@defproc[(udp-addresses [udp-port udp?]
[port-numbers? any/c #f])
(or/c (values string? string?)
(values string? (integer-in 1 65535)
string? (integer-in 1 65535)))]{
Returns two strings when @scheme[port-numbers?] is @scheme[#f] (the
default). The first string is the Internet address for the local
machine a viewed by the given @tech{UDP socket}'s connection. (For most
machines, the answer corresponds to the current machine's only
Internet address, but when a machine serves multiple addresses, the
result is connection-specific.) The second string is the Internet
address for the other end of the connection.
If @scheme[port-numbers?] is true, then four results are returned: a
string for the local machine's address, an exact integer between
@scheme[1] and @scheme[65535] for the local machine's port number, a
string for the remote machine's address, and an exact integer between
@scheme[1] and @scheme[65535] for the remote machine's port number.
If the given port has been closed, the @exnraise[exn:fail:network].}

66
collects/tests/mzscheme/file.ss
View File

@ -1,4 +1,4 @@
(require mzlib/os)
(load-relative "loadtest.ss")
(Section 'file)
@ -290,12 +290,13 @@
(err/rt-test (open-output-file (build-path (current-directory) "baddir" "x"))
exn:fail:filesystem?)
(when (file-exists? "tmp4")
(delete-file "tmp4"))
(let ([p (open-output-file "tmp4")])
(define tempfilename (make-temporary-file))
(when (file-exists? tempfilename)
(delete-file tempfilename))
(let ([p (open-output-file tempfilename)])
(err/rt-test (write-special 'foo p) exn:application:mismatch?)
(test #t integer? (port-file-identity p))
(let ([q (open-input-file "tmp4")])
(let ([q (open-input-file tempfilename)])
(test (port-file-identity p) port-file-identity q)
(close-input-port q)
(err/rt-test (file-position q) exn:fail?)
@ -305,23 +306,23 @@
(err/rt-test (port-file-identity p) exn:fail?))
(err/rt-test (let ([c (make-custodian)])
(let ([p (parameterize ([current-custodian c])
(open-output-file "tmp4" #:exists 'replace))])
(open-output-file tempfilename #:exists 'replace))])
(custodian-shutdown-all c)
(display 'hi p)))
exn:fail?)
(err/rt-test (open-output-file "tmp4" #:exists 'error) exn:fail:filesystem?)
(define p (open-output-file "tmp4" #:exists 'replace))
(err/rt-test (open-output-file tempfilename #:exists 'error) exn:fail:filesystem?)
(define p (open-output-file tempfilename #:exists 'replace))
(display 7 p)
(display "" p)
(close-output-port p)
(close-output-port (open-output-file "tmp4" #:exists 'truncate))
(define p (open-input-file "tmp4"))
(close-output-port (open-output-file tempfilename #:exists 'truncate))
(define p (open-input-file tempfilename))
(test eof read p)
(close-input-port p)
(define p (open-output-file "tmp4" #:exists 'replace))
(define p (open-output-file tempfilename #:exists 'replace))
(display 7 p)
(close-output-port p)
(define p (open-output-file "tmp4" #:exists 'append))
(define p (open-output-file tempfilename #:exists 'append))
(display 7 p)
(close-output-port p)
(err/rt-test (display 9 p) exn:fail?)
@ -330,39 +331,39 @@
(err/rt-test (let ([c (make-custodian)])
(let ([p (parameterize ([current-custodian c])
(open-input-file "tmp4"))])
(open-input-file tempfilename))])
(custodian-shutdown-all c)
(read p)))
exn:fail?)
(define p (open-input-file "tmp4"))
(define p (open-input-file tempfilename))
(test 77 read p)
(close-input-port p)
(err/rt-test (read p) exn:fail?)
(err/rt-test (read-char p) exn:fail?)
(err/rt-test (char-ready? p) exn:fail?)
(define-values (in-p out-p) (open-input-output-file "tmp4" #:exists 'update))
(define-values (in-p out-p) (open-input-output-file tempfilename #:exists 'update))
(test #\7 read-char in-p)
(close-output-port out-p)
(test #\7 read-char in-p)
(test eof read-char in-p)
(close-input-port in-p)
(define p (open-output-file "tmp4" #:exists 'update))
(define p (open-output-file tempfilename #:exists 'update))
(display 6 p)
(close-output-port p)
(test 2 file-size "tmp4")
(define p (open-input-file "tmp4"))
(test 2 file-size tempfilename)
(define p (open-input-file tempfilename))
(test 67 read p)
(test eof read p)
(close-input-port p)
(define p (open-output-file "tmp4" #:exists 'update))
(define p (open-output-file tempfilename #:exists 'update))
(file-position p 1)
(display 68 p)
(close-output-port p)
(test 3 file-size "tmp4")
(define p (open-input-file "tmp4"))
(test 3 file-size tempfilename)
(define p (open-input-file tempfilename))
(test 0 file-position p)
(test 668 read p)
(test 3 file-position p)
@ -381,12 +382,12 @@
(test 3 file-position p)
(close-input-port p)
(close-output-port (open-output-file "tmp4" #:exists 'truncate/replace))
(define p (open-input-file "tmp4"))
(close-output-port (open-output-file tempfilename #:exists 'truncate/replace))
(define p (open-input-file tempfilename))
(test eof read p)
(close-input-port p)
(define-values (in-p out-p) (open-input-output-file "tmp4" #:exists 'update))
(define-values (in-p out-p) (open-input-output-file tempfilename #:exists 'update))
(fprintf out-p "hi~n")
(flush-output out-p)
(test eof read-char in-p)
@ -401,7 +402,7 @@
(test 1 file-position out-p)
(write-char #\x out-p)
(close-output-port out-p)
(test 'hx with-input-from-file "tmp4" read)
(test 'hx with-input-from-file tempfilename read)
(arity-test call-with-input-file 2 2)
(arity-test call-with-output-file 2 2)
@ -1257,10 +1258,15 @@
;;----------------------------------------------------------------------
;; TCP
(define (listen-port x)
(let-values ([(la lp pa pp) (tcp-addresses x #t)])
lp))
(let ([do-once
(lambda (evt?)
(let* ([pn 40001]
[l (tcp-listen pn 5 #t)])
(let* (
[l (tcp-listen 0 5 #t)]
[pn (listen-port l)])
(let-values ([(r1 w1) (tcp-connect "localhost" pn)]
[(r2 w2) (if evt?
(apply values (sync (tcp-accept-evt l)))
@ -1289,7 +1295,8 @@
;; Check that `tcp-accept-evt' uses the right custodian
(let ()
(define l (tcp-listen 40000 5 #t))
(define l (tcp-listen 0 5 #t))
(define port (listen-port l))
(define c (make-custodian))
(define-values (i o) (values #f #f))
@ -1300,8 +1307,7 @@
(parameterize ([current-custodian c])
(set!-values (i o) (apply values (sync (tcp-accept-evt l))))))))
(define-values (ci co) (tcp-connect "localhost" 40000))
(define-values (ci co) (tcp-connect "localhost" port))
(sync t)
(custodian-shutdown-all c)

8
collects/tests/mzscheme/thread.ss
View File

@ -557,13 +557,17 @@
(test #f semaphore-try-wait? s)
(test #f semaphore-try-wait? s2))))
(define (listen-port x)
(let-values ([(la lp pa pp) (tcp-addresses x #t)])
lp))
(let ([s (make-semaphore)]
[s-t (make-semaphore)]
[portnum (+ 40000 (random 100))]) ; so parallel tests work ok
[l (tcp-listen 0 5 #t)])
(let ([t (thread
(lambda ()
(sync s-t)))]
[l (tcp-listen portnum 5 #t)]
[portnum (listen-port l)] ; so parallel tests work ok
[orig-thread (current-thread)])
(let-values ([(r w) (make-pipe)])

23
collects/tests/mzscheme/udp.ss
View File

@ -36,21 +36,28 @@
(err/rt-test (udp-send udp1 us1) exn:fail:network?)
(define udp2 (udp-open-socket "127.0.0.1"))
(test (void) udp-bind! udp2 "127.0.0.1" 40007)
(define (local-bind-port x)
(let-values ([(la lp pa pp) (udp-addresses x #t)])
lp))
(test (void) udp-bind! udp2 "127.0.0.1" 0)
(define port (local-bind-port udp2))
(test-values '(#f #f #f) (lambda () (udp-receive!* udp2 us1)))
(test (void) udp-send-to udp1 "127.0.0.1" 40007 #"Hiya.")
(test (void) udp-send-to udp1 "127.0.0.1" port #"Hiya.")
(define recv-got (call-with-values (lambda () (udp-receive! udp2 us1)) list))
(test 5 car recv-got)
(test "127.0.0.1" cadr recv-got)
(define udp1-port (caddr recv-got))
(test #"Hiya.\0\0\0\0\0" values us1)
(test (void) udp-send-to udp1 "127.0.0.1" 40007 #"...another?..." 3 11)
(test (void) udp-send-to udp1 "127.0.0.1" port #"...another?..." 3 11)
(test-values (list 8 "127.0.0.1" udp1-port) (lambda () (udp-receive! udp2 us1 1)))
(test #"Hanother?\0" values us1)
(test (void) udp-connect! udp1 "127.0.0.1" 40007)
(test (void) udp-connect! udp1 "127.0.0.1" port )
(test #t udp-connected? udp1)
(test #f udp-connected? udp2)
@ -75,7 +82,7 @@
(sleep 0.05)
(flush-udp-errors udp1)
(test-values '(#f #f #f) (lambda () (udp-receive!* udp2 us1)))
(err/rt-test (udp-send-to udp1 "127.0.0.1" 40007 #"not ok -- currently connected") exn:fail:network?)
(err/rt-test (udp-send-to udp1 "127.0.0.1" port #"not ok -- currently connected") exn:fail:network?)
(test #t udp-send* udp1 #"lots of stuff")
(sleep 0.05)
(flush-udp-errors udp1)
@ -96,7 +103,7 @@
(test #t evt? udp2-r)
(test #f sync/timeout 0.05 udp2-r)
(test (void) sync (udp-send-to-evt udp1 "127.0.0.1" 40007 #"here's more"))
(test (void) sync (udp-send-to-evt udp1 "127.0.0.1" port #"here's more"))
(sleep 0.05)
(test udp2-r sync udp2-r)
(test udp2-r sync udp2-r)
@ -156,7 +163,7 @@
;; udp1 is now closed...
(err/rt-test (udp-bind! udp1 "127.0.0.1" 40008) exn:fail:network?)
(err/rt-test (udp-connect! udp1 "127.0.0.1" 40007) exn:fail:network?)
(err/rt-test (udp-connect! udp1 "127.0.0.1" port) exn:fail:network?)
(err/rt-test (udp-send-to udp1 "127.0.0.1" 40000 #"hello") exn:fail:network?)
(err/rt-test (udp-send udp1 #"hello") exn:fail:network?)
(err/rt-test (udp-receive! udp1 (make-bytes 10)) exn:fail:network?)
@ -170,4 +177,4 @@
(let ([w (udp-receive-ready-evt udp1)])
(test w sync w))
(test #t evt? (udp-receive!-evt udp1 us1))
(test #t evt? (udp-send-to-evt udp1 "127.0.0.1" 40007 #"here's more"))
(test #t evt? (udp-send-to-evt udp1 "127.0.0.1" port #"here's more"))

310
src/mzscheme/src/network.c
View File

@ -282,6 +282,8 @@ void scheme_init_network(Scheme_Env *env)
/* These two need o be outside of USE_TCP */
#define PORT_ID_TYPE "exact integer in [1, 65535]"
#define CHECK_PORT_ID(obj) (SCHEME_INTP(obj) && (SCHEME_INT_VAL(obj) >= 1) && (SCHEME_INT_VAL(obj) <= 65535))
#define LISTEN_PORT_ID_TYPE "exact integer in [0, 65535]"
#define CHECK_LISTEN_PORT_ID(obj) (SCHEME_INTP(obj) && (SCHEME_INT_VAL(obj) >= 0) && (SCHEME_INT_VAL(obj) <= 65535))
#ifdef USE_TCP
@ -661,7 +663,7 @@ struct mz_addrinfo *scheme_get_host_address(const char *address, int id, int *er
GC_CAN_IGNORE struct mz_addrinfo *r, hints;
r = NULL;
if (id) {
if (id >= 0) {
service = buf;
sprintf(buf, "%d", id);
} else
@ -1735,6 +1737,18 @@ tcp_connect_break(int argc, Scheme_Object *argv[])
return scheme_call_enable_break(tcp_connect, argc, argv);
}
static short get_no_portno(tcp_t socket)
{
GC_CAN_IGNORE struct sockaddr_in addr;
unsigned int l = sizeof(struct sockaddr);
if (getsockname(socket, (struct sockaddr *) &addr, &l)) {
scheme_raise_exn(MZEXN_FAIL_NETWORK, "tcp-addresses: could not get local address (%e)", SOCK_ERRNO());
}
return addr.sin_port;
}
static Scheme_Object *
tcp_listen(int argc, Scheme_Object *argv[])
{
@ -1746,8 +1760,8 @@ tcp_listen(int argc, Scheme_Object *argv[])
#endif
const char *address;
if (!CHECK_PORT_ID(argv[0]))
scheme_wrong_type("tcp-listen", PORT_ID_TYPE, 0, argc, argv);
if (!CHECK_LISTEN_PORT_ID(argv[0]))
scheme_wrong_type("tcp-listen", LISTEN_PORT_ID_TYPE, 0, argc, argv);
if (argc > 1) {
if (!SCHEME_INTP(argv[1]) || (SCHEME_INT_VAL(argv[1]) < 1))
scheme_wrong_type("tcp-listen", "small positive integer", 1, argc, argv);
@ -1819,6 +1833,9 @@ tcp_listen(int argc, Scheme_Object *argv[])
IPv6 doesn't work right. */
int v6_loop = (any_v6 && any_v4), skip_v6 = 0;
#endif
int first_time = 1;
int first_was_zero = 0;
short no_port = 0;
errid = 0;
for (addr = tcp_listen_addr; addr; ) {
@ -1887,7 +1904,18 @@ tcp_listen(int argc, Scheme_Object *argv[])
setsockopt(s, SOL_SOCKET, SO_REUSEADDR, (char *)(&reuse), sizeof(int));
}
if (first_was_zero) {
((struct sockaddr_in *)addr->ai_addr)->sin_port = no_port;
}
if (!bind(s, addr->ai_addr, addr->ai_addrlen)) {
if (first_time) {
if (((struct sockaddr_in *)addr->ai_addr)->sin_port == 0) {
no_port = get_no_portno(s);
first_was_zero = 1;
}
first_time = 0;
}
if (!listen(s, backlog)) {
if (!pos) {
l = scheme_malloc_tagged(sizeof(listener_t) + ((count - 1) * sizeof(tcp_t)));
@ -2204,13 +2232,19 @@ static int extract_svc_value(char *svc_buf)
return id;
}
#define SCHEME_LISTEN_PORTP(p) SAME_TYPE(SCHEME_TYPE(p), scheme_listener_type)
#define SCHEME_UDP_PORTP(p) SAME_TYPE(SCHEME_TYPE(p), scheme_udp_type)
static Scheme_Object *tcp_addresses(int argc, Scheme_Object *argv[])
{
#ifdef USE_TCP
tcp_t socket = 0;
Scheme_Tcp *tcp = NULL;
int closed = 0;
Scheme_Object *result[4];
int with_ports = 0;
int listener = 0;
int udp = 0;
if (SCHEME_OUTPUT_PORTP(argv[0])) {
Scheme_Output_Port *op;
@ -2229,8 +2263,20 @@ static Scheme_Object *tcp_addresses(int argc, Scheme_Object *argv[])
if (argc > 1)
with_ports = SCHEME_TRUEP(argv[1]);
if (!tcp)
scheme_wrong_type("tcp-addresses", "tcp-port", 0, argc, argv);
if (tcp) {
socket = tcp->tcp;
}
else {
if (SCHEME_LISTEN_PORTP(argv[0])) {
listener = 1;
socket = ((listener_t *)argv[0])->s[0];
} else if (SCHEME_UDP_PORTP(argv[0])) {
udp = 1;
socket = ((Scheme_UDP *)argv[0])->s;
} else {
scheme_wrong_type("tcp-addresses", "tcp-port", 0, argc, argv);
}
}
if (closed)
scheme_raise_exn(MZEXN_FAIL_NETWORK,
@ -2242,23 +2288,26 @@ static Scheme_Object *tcp_addresses(int argc, Scheme_Object *argv[])
char here[MZ_SOCK_NAME_MAX_LEN], there[MZ_SOCK_NAME_MAX_LEN];
char host_buf[MZ_SOCK_HOST_NAME_MAX_LEN];
char svc_buf[MZ_SOCK_SVC_NAME_MAX_LEN];
unsigned int here_len, there_len;
unsigned int here_len;
unsigned int there_len = 0;
int peerrc = 0;
l = sizeof(here);
if (getsockname(tcp->tcp, (struct sockaddr *)here, &l)) {
if (getsockname(socket, (struct sockaddr *)here, &l)) {
scheme_raise_exn(MZEXN_FAIL_NETWORK,
"tcp-addresses: could not get local address (%e)",
SOCK_ERRNO());
}
here_len = l;
l = sizeof(there);
if (getpeername(tcp->tcp, (struct sockaddr *)there, &l)) {
scheme_raise_exn(MZEXN_FAIL_NETWORK,
"tcp-addresses: could not get peer address (%e)",
SOCK_ERRNO());
if (!listener) {
l = sizeof(there);
peerrc = getpeername(socket, (struct sockaddr *)there, &l);
if (peerrc && !udp) {
scheme_raise_exn(MZEXN_FAIL_NETWORK, "tcp-addresses: could not get peer address (%e)", SOCK_ERRNO());
}
there_len = l;
}
there_len = l;
scheme_getnameinfo((struct sockaddr *)here, here_len,
host_buf, sizeof(host_buf),
@ -2270,14 +2319,20 @@ static Scheme_Object *tcp_addresses(int argc, Scheme_Object *argv[])
result[1] = scheme_make_integer(l);
}
scheme_getnameinfo((struct sockaddr *)there, there_len,
host_buf, sizeof(host_buf),
(with_ports ? svc_buf : NULL),
(with_ports ? sizeof(svc_buf) : 0));
result[with_ports ? 2 : 1] = scheme_make_utf8_string(host_buf);
if (with_ports) {
l = extract_svc_value(svc_buf);
result[3] = scheme_make_integer(l);
if (listener || (udp && peerrc)) {
result[with_ports ? 2 : 1] = scheme_make_utf8_string("0.0.0.0");
result[3] = scheme_make_integer(0);
}
else {
scheme_getnameinfo((struct sockaddr *)there, there_len,
host_buf, sizeof(host_buf),
(with_ports ? svc_buf : NULL),
(with_ports ? sizeof(svc_buf) : 0));
result[with_ports ? 2 : 1] = scheme_make_utf8_string(host_buf);
if (with_ports) {
l = extract_svc_value(svc_buf);
result[3] = scheme_make_integer(l);
}
}
}
# else
@ -2651,138 +2706,125 @@ udp_connected_p(int argc, Scheme_Object *argv[])
static Scheme_Object *udp_bind_or_connect(const char *name, int argc, Scheme_Object *argv[], int do_bind)
{
#ifdef UDP_IS_SUPPORTED
Scheme_UDP *udp;
char *address = "";
unsigned short origid, id;
GC_CAN_IGNORE struct mz_addrinfo *udp_bind_addr;
int errid, err;
udp = (Scheme_UDP *)argv[0];
#endif
if (!SCHEME_UDPP(argv[0]))
scheme_wrong_type(name, "udp socket", 0, argc, argv);
#ifdef UDP_IS_SUPPORTED
if (!SCHEME_FALSEP(argv[1]) && !SCHEME_CHAR_STRINGP(argv[1]))
scheme_wrong_type(name, "string or #f", 1, argc, argv);
if ((do_bind || !SCHEME_FALSEP(argv[2])) && !CHECK_PORT_ID(argv[2]))
scheme_wrong_type(name, (do_bind ? PORT_ID_TYPE : PORT_ID_TYPE " or #f"), 2, argc, argv);
if (SCHEME_TRUEP(argv[1])) {
Scheme_Object *bs;
bs = scheme_char_string_to_byte_string(argv[1]);
address = SCHEME_BYTE_STR_VAL(bs);
} else
address = NULL;
if (SCHEME_TRUEP(argv[2]))
origid = (unsigned short)SCHEME_INT_VAL(argv[2]);
else
origid = 0;
{
Scheme_UDP *udp;
char *address = NULL;
unsigned short port = 0;
GC_CAN_IGNORE struct mz_addrinfo *udp_bind_addr = NULL;
if (!do_bind && (SCHEME_TRUEP(argv[1]) != SCHEME_TRUEP(argv[2]))) {
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: last two arguments must be both #f or both non-#f, given: %V %V",
name, argv[1], argv[2]);
}
udp = (Scheme_UDP *)argv[0];
scheme_security_check_network(name, address, origid, !do_bind);
if (!SCHEME_FALSEP(argv[1]) && !SCHEME_CHAR_STRINGP(argv[1]))
scheme_wrong_type(name, "string or #f", 1, argc, argv);
if (do_bind && !CHECK_LISTEN_PORT_ID(argv[2]))
scheme_wrong_type(name, LISTEN_PORT_ID_TYPE, 2, argc, argv);
if (!do_bind && !SCHEME_FALSEP(argv[2]) && !CHECK_PORT_ID(argv[2]))
scheme_wrong_type(name, PORT_ID_TYPE " or #f", 2, argc, argv);
if (udp->s == INVALID_SOCKET) {
scheme_raise_exn(MZEXN_FAIL_NETWORK,
"%s: udp socket was already closed: %V",
name,
udp);
return NULL;
}
if (SCHEME_TRUEP(argv[1])) {
Scheme_Object *bs;
bs = scheme_char_string_to_byte_string(argv[1]);
address = SCHEME_BYTE_STR_VAL(bs);
}
if (SCHEME_TRUEP(argv[2]))
port = (unsigned short)SCHEME_INT_VAL(argv[2]);
if (!do_bind && (SCHEME_TRUEP(argv[1]) != SCHEME_TRUEP(argv[2]))) {
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: last two arguments must be both #f or both non-#f, given: %V %V",
name, argv[1], argv[2]);
}
if (do_bind && udp->bound) {
scheme_raise_exn(MZEXN_FAIL_NETWORK,
"%s: udp socket is already bound: %V",
name,
udp);
return NULL;
}
scheme_security_check_network(name, address, port, !do_bind);
id = origid;
if (address || id)
udp_bind_addr = scheme_get_host_address(address, id, &err, -1, do_bind, 0);
else
udp_bind_addr = NULL;
if (udp_bind_addr || !origid) {
if (do_bind) {
if (!bind(udp->s, udp_bind_addr->ai_addr, udp_bind_addr->ai_addrlen)) {
udp->bound = 1;
mz_freeaddrinfo(udp_bind_addr);
return scheme_void;
}
errid = SOCK_ERRNO();
} else {
int ok = 1;
if (udp->s == INVALID_SOCKET) {
scheme_raise_exn(MZEXN_FAIL_NETWORK, "%s: udp socket was already closed: %V", name, udp);
return NULL;
}
if (do_bind && udp->bound) {
scheme_raise_exn(MZEXN_FAIL_NETWORK, "%s: udp socket is already bound: %V", name, udp);
return NULL;
}
/* DISCONNECT */
if (SCHEME_FALSEP(argv[1]) && SCHEME_FALSEP(argv[2])) {
int errid = 0;
if (udp->connected) {
int ok;
#ifdef USE_NULL_TO_DISCONNECT_UDP
if (!origid) {
if (udp->connected)
ok = !connect(udp->s, NULL, 0);
} else
ok = !connect(udp->s, NULL, 0);
#else //#ifndef USE_NULL_TO_DISCONNECT_UDP
GC_CAN_IGNORE mz_unspec_address ua;
ua.sin_family = AF_UNSPEC;
ua.sin_port = 0;
memset(&(ua.sin_addr), 0, sizeof(ua.sin_addr));
memset(&(ua.sin_zero), 0, sizeof(ua.sin_zero));
ok = !connect(udp->s, (struct sockaddr *)&ua, sizeof(ua));
#endif
{
if (udp_bind_addr)
ok = !connect(udp->s, udp_bind_addr->ai_addr, udp_bind_addr->ai_addrlen);
#ifndef USE_NULL_TO_DISCONNECT_UDP
else {
GC_CAN_IGNORE mz_unspec_address ua;
ua.sin_family = AF_UNSPEC;
ua.sin_port = 0;
memset(&(ua.sin_addr), 0, sizeof(ua.sin_addr));
memset(&(ua.sin_zero), 0, sizeof(ua.sin_zero));
ok = !connect(udp->s, (struct sockaddr *)&ua, sizeof(ua));
}
#endif
}
if (!ok)
errid = SOCK_ERRNO();
else
errid = 0;
if (!ok && OK_DISCONNECT_ERROR(errid) && !origid) {
/* It's ok. We were trying to disconnect */
ok = 1;
if (!ok) errid = SOCK_ERRNO();
if (ok || OK_DISCONNECT_ERROR(errid)) {
udp->connected = 0;
return scheme_void;
}
else {
scheme_raise_exn(MZEXN_FAIL_NETWORK, "%s: can't disconnect port: %d on address: %s (%E)", name, port, address ? address : "#f", errid);
}
}
return scheme_void;
}
if (ok) {
if (origid)
udp->connected = 1;
else
udp->connected = 0;
if (udp_bind_addr)
mz_freeaddrinfo(udp_bind_addr);
return scheme_void;
/* RESOLVE ADDRESS */
if (address || port) {
int err;
udp_bind_addr = scheme_get_host_address(address, port, &err, -1, do_bind, 0);
if (!udp_bind_addr) {
scheme_raise_exn(MZEXN_FAIL_NETWORK, "%s: can't resolve address: %s (%N)", name, address, 1, err);
return NULL;
}
}
if (udp_bind_addr)
/* CONNECT CASE */
if (!do_bind) {
int ok = !connect(udp->s, udp_bind_addr->ai_addr, udp_bind_addr->ai_addrlen);
mz_freeaddrinfo(udp_bind_addr);
scheme_raise_exn(MZEXN_FAIL_NETWORK,
"%s: can't %s to port: %d on address: %s (%E)",
name,
do_bind ? "bind" : "connect",
origid,
address ? address : "#f",
errid);
return NULL;
} else {
scheme_raise_exn(MZEXN_FAIL_NETWORK,
"%s: can't resolve address: %s (%N)",
name,
address, 1, err);
return NULL;
if (ok) {
udp->connected = 1;
return scheme_void;
}
else {
scheme_raise_exn(MZEXN_FAIL_NETWORK, "%s: can't connect to port: %d on address: %s (%E)", name, port, address ? address : "#f", SOCK_ERRNO());
return NULL;
}
}
/* BIND CASE */
else {
int ok;
if (udp_bind_addr == NULL ) {
GC_CAN_IGNORE mz_unspec_address ua;
memset(&ua, 0, sizeof(mz_unspec_address));
ua.sin_family = AF_UNSPEC;
ua.sin_port = 0;
memset(&(ua.sin_addr), 0, sizeof(ua.sin_addr));
memset(&(ua.sin_zero), 0, sizeof(ua.sin_zero));
ok = !bind(udp->s, (struct sockaddr *)&ua, sizeof(ua));
}
else {
ok = !bind(udp->s, udp_bind_addr->ai_addr, udp_bind_addr->ai_addrlen);
mz_freeaddrinfo(udp_bind_addr);
}
if (ok) {
udp->bound = 1;
return scheme_void;
}
else {
scheme_raise_exn(MZEXN_FAIL_NETWORK, "%s: can't bind to port: %d on address: %s (%E)", name, port, address ? address : "#f", SOCK_ERRNO());
return NULL;
}
}
}
#else
return scheme_void;