From ac7853dc0078a07239081651b93942c3a7692d81 Mon Sep 17 00:00:00 2001 From: Kevin Tew Date: Tue, 20 Oct 2009 17:00:20 +0000 Subject: [PATCH] Allow binding to ephemeral ports svn: r16382 --- collects/scheme/tcp.ss | 16 +- collects/scheme/udp.ss | 11 +- .../scribblings/reference/networking.scrbl | 36 +- collects/tests/mzscheme/file.ss | 66 ++-- collects/tests/mzscheme/thread.ss | 8 +- collects/tests/mzscheme/udp.ss | 23 +- src/mzscheme/src/network.c | 310 ++++++++++-------- 7 files changed, 288 insertions(+), 182 deletions(-) diff --git a/collects/scheme/tcp.ss b/collects/scheme/tcp.ss index fd3667a746..01639b5cf0 100644 --- a/collects/scheme/tcp.ss +++ b/collects/scheme/tcp.ss @@ -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)))]))) + diff --git a/collects/scheme/udp.ss b/collects/scheme/udp.ss index 2c4bb2cd7e..567800552c 100644 --- a/collects/scheme/udp.ss +++ b/collects/scheme/udp.ss @@ -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))]))) diff --git a/collects/scribblings/reference/networking.scrbl b/collects/scribblings/reference/networking.scrbl index 071ad00fe9..0fa1e02273 100644 --- a/collects/scribblings/reference/networking.scrbl +++ b/collects/scribblings/reference/networking.scrbl @@ -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].} diff --git a/collects/tests/mzscheme/file.ss b/collects/tests/mzscheme/file.ss index 7c14452ffc..57565cbb16 100644 --- a/collects/tests/mzscheme/file.ss +++ b/collects/tests/mzscheme/file.ss @@ -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) diff --git a/collects/tests/mzscheme/thread.ss b/collects/tests/mzscheme/thread.ss index 7cfcb2cf69..7ff1caf2f1 100644 --- a/collects/tests/mzscheme/thread.ss +++ b/collects/tests/mzscheme/thread.ss @@ -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)]) diff --git a/collects/tests/mzscheme/udp.ss b/collects/tests/mzscheme/udp.ss index 6fddc523b6..61aae4da4d 100644 --- a/collects/tests/mzscheme/udp.ss +++ b/collects/tests/mzscheme/udp.ss @@ -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")) diff --git a/src/mzscheme/src/network.c b/src/mzscheme/src/network.c index 90adde8bfb..eaafaec2ac 100644 --- a/src/mzscheme/src/network.c +++ b/src/mzscheme/src/network.c @@ -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;