Add udp-set-receive-buffer-size!

pkgs/base/info.rkt

@@ -12,7 +12,7 @@
 
 (define collection 'multi)
 
-(define version "7.1.0.10")
+(define version "7.1.0.11")
 
 (define deps `("racket-lib"
                ["racket" #:version ,version]))

pkgs/racket-doc/scribblings/reference/networking.scrbl

@@ -494,6 +494,22 @@ called, then either a datagram is received or the @racket[exn:break]
 exception is raised, but not both.}
 
 
+@defproc[(udp-set-receive-buffer-size! [udp-socket udp?]
+                                       [size exact-positive-integer?])
+                                       void]{
+
+On Unix systems, set the receive buffer size (@tt{SO_RCVBUF}) for
+@racket[udp-socket].
+
+If @racket[size] is greater than the maximum allowed by the system,
+the @exnraise[exn:fail].
+
+Using a larger buffer can minimize packet loss that can occur during a
+major garbage collection.
+
+@history[#:added "7.1.0.11"]}
+
+
 @defproc[(udp-close [udp-socket udp?]) void?]{
 
 Closes @racket[udp-socket], discarding unreceived datagrams.  If the

pkgs/racket-test-core/tests/racket/udp.rktl

@@ -55,6 +55,21 @@
 (test #f udp-bound? udp1)
 (test #f udp-connected? udp1)
 
+(err/rt-test (udp-set-receive-buffer-size! udp1 -1))
+(err/rt-test (udp-set-receive-buffer-size! udp1 0))
+;; Something a user program might do to find the max allowed size
+(test-values
+ '(ok)
+ (λ ()
+   (let loop ([n 4096])
+     (with-handlers ([exn:fail?
+                      (λ _
+                        (let ([n (/ n 2)])
+                          (udp-set-receive-buffer-size! udp1 n)
+                          'ok))])
+       (udp-set-receive-buffer-size! udp1 n)
+       (loop (* 2 n))))))
+
 ;; not bound:
 (err/rt-test (udp-receive! udp1 us1) exn:fail:network?)
 (err/rt-test (udp-receive!* udp1 us1) exn:fail:network?)

racket/collects/racket/udp.rkt

@@ -1,38 +1,38 @@
-
 (module udp '#%kernel
   (#%require '#%network)
 
-  (#%provide udp-open-socket 
+  (#%provide udp-open-socket
-             udp-close 
+             udp-close
-             udp? 
+             udp?
-             udp-bound? 
+             udp-bound?
-             udp-connected? 
+             udp-connected?
-             udp-bind! 
+             udp-bind!
-             udp-connect! 
+             udp-connect!
-             udp-send-to 
+             udp-send-to
-             udp-send 
+             udp-send
-             udp-send-to* 
+             udp-send-to*
-             udp-send* 
+             udp-send*
-             udp-send-to/enable-break 
+             udp-send-to/enable-break
-             udp-send/enable-break 
+             udp-send/enable-break
-             udp-receive! 
+             udp-receive!
-             udp-receive!* 
+             udp-receive!*
-             udp-receive!/enable-break 
+             udp-receive!/enable-break
-             udp-receive-ready-evt 
+             udp-receive-ready-evt
-             udp-send-ready-evt 
+             udp-send-ready-evt
-             udp-receive!-evt 
+             udp-receive!-evt
-             udp-send-evt 
+             udp-set-receive-buffer-size!
+             udp-send-evt
              udp-send-to-evt
              udp-addresses
-	     udp-multicast-loopback?
+             udp-multicast-loopback?
-	     udp-multicast-set-loopback!
+             udp-multicast-set-loopback!
-	     udp-multicast-ttl
+             udp-multicast-ttl
-	     udp-multicast-set-ttl!
+             udp-multicast-set-ttl!
-	     udp-multicast-interface
+             udp-multicast-interface
-	     udp-multicast-set-interface!
+             udp-multicast-set-interface!
-	     udp-multicast-join-group!
+             udp-multicast-join-group!
-	     udp-multicast-leave-group!)
+             udp-multicast-leave-group!)
-      
+
   (define-values (udp-addresses)
     (case-lambda
       [(x) (udp-addresses x #f)]

racket/src/cs/primitive/network.ss

@@ -40,4 +40,5 @@
   [udp-send-to-evt (known-procedure 112)]
   [udp-send-to/enable-break (known-procedure 112)]
   [udp-send/enable-break (known-procedure 28)]
+  [udp-set-receive-buffer-size! (known-procedure 4)]
   [udp? (known-procedure 2)])

racket/src/io/network/udp-receive.rkt

@@ -16,9 +16,11 @@
 (provide udp-receive!
          udp-receive!*
          udp-receive!/enable-break
-         
+
          udp-receive!-evt
-         udp-receive-ready-evt)
+         udp-receive-ready-evt
+
+         udp-set-receive-buffer-size!)
 
 (define/who (udp-receive! u bstr [start 0] [end (and (bytes? bstr) (bytes-length bstr))])
   (do-udp-receive! who u bstr start end))
@@ -154,3 +156,18 @@
 (struct udp-receiving-ready-evt rktio-evt ()
   #:reflection-name 'udp-receive-ready-evt
   #:authentic)
+
+;; ----------------------------------------
+
+(define/who (udp-set-receive-buffer-size! u size)
+  (check who udp? u)
+  (check who exact-nonnegative-integer? size)
+  (atomically
+   (check-udp-closed who u)
+   (define r (rktio_udp_set_receive_buffer_size rktio (udp-s u) size))
+   (when (rktio-error? r)
+     (raise-option-error who "set" r))))
+
+(define (raise-option-error who mode v)
+  (end-atomic)
+  (raise-network-error who v (string-append mode "sockopt failed")))

racket/src/io/network/udp.rkt

@@ -4,35 +4,36 @@
          "udp-receive.rkt"
          "udp-multicast.rkt")
 
-(provide   udp-open-socket
+(provide udp-open-socket
-           udp-close
+         udp-close
-           udp?
+         udp?
-           udp-bound?
+         udp-bound?
-           udp-connected?
+         udp-connected?
-           udp-bind!
+         udp-bind!
-           udp-connect!
+         udp-connect!
 
-           udp-send
+         udp-send
-           udp-send*
+         udp-send*
-           udp-send-to/enable-break
+         udp-send-to/enable-break
-           udp-send-to
+         udp-send-to
-           udp-send-to*
+         udp-send-to*
-           udp-send/enable-break
+         udp-send/enable-break
-           udp-send-evt
+         udp-send-evt
-           udp-send-to-evt
+         udp-send-to-evt
-           udp-send-ready-evt
+         udp-send-ready-evt
-         
-           udp-receive!
-           udp-receive!*
-           udp-receive!/enable-break
-           udp-receive!-evt
-           udp-receive-ready-evt
 
-           udp-multicast-join-group!
+         udp-receive!
-           udp-multicast-leave-group!
+         udp-receive!*
-           udp-multicast-interface
+         udp-receive!/enable-break
-           udp-multicast-set-interface!
+         udp-receive!-evt
-           udp-multicast-loopback?
+         udp-receive-ready-evt
-           udp-multicast-set-loopback!
+         udp-set-receive-buffer-size!
-           udp-multicast-ttl
+
-           udp-multicast-set-ttl!)
+         udp-multicast-join-group!
+         udp-multicast-leave-group!
+         udp-multicast-interface
+         udp-multicast-set-interface!
+         udp-multicast-loopback?
+         udp-multicast-set-loopback!
+         udp-multicast-ttl
+         udp-multicast-set-ttl!)

racket/src/racket/src/network.c

@@ -95,6 +95,7 @@ static Scheme_Object *udp_send_enable_break(int argc, Scheme_Object *argv[]);
 static Scheme_Object *udp_receive(int argc, Scheme_Object *argv[]);
 static Scheme_Object *udp_receive_star(int argc, Scheme_Object *argv[]);
 static Scheme_Object *udp_receive_enable_break(int argc, Scheme_Object *argv[]);
+static Scheme_Object *udp_set_receive_buffer_size(int argc, Scheme_Object *argv[]);
 static Scheme_Object *udp_read_ready_evt(int argc, Scheme_Object *argv[]);
 static Scheme_Object *udp_write_ready_evt(int argc, Scheme_Object *argv[]);
 static Scheme_Object *udp_read_evt(int argc, Scheme_Object *argv[]);
@@ -171,6 +172,7 @@ void scheme_init_network(Scheme_Startup_Env *env)
   ADD_PRIM_W_ARITY  ( "udp-multicast-set-interface!", udp_multicast_set_interface,2,2, env) ;
   ADD_PRIM_W_ARITY  ( "udp-multicast-join-group!" , udp_multicast_join_group , 3 , 3 , env) ;
   ADD_PRIM_W_ARITY  ( "udp-multicast-leave-group!", udp_multicast_leave_group, 3 , 3 , env) ;
+  ADD_PRIM_W_ARITY  ( "udp-set-receive-buffer-size!", udp_set_receive_buffer_size, 2 , 2 , env) ;
 
   scheme_restore_prim_instance(env);
 }
@@ -2694,6 +2696,28 @@ udp_multicast_leave_group(int argc, Scheme_Object *argv[])
 					   argv);
 }
 
+static Scheme_Object *udp_set_receive_buffer_size(int argc, Scheme_Object *argv[])
+{
+  Scheme_UDP *udp = (Scheme_UDP *)argv[0];
+
+  if (!SCHEME_UDPP(argv[0]))
+    scheme_wrong_contract("udp-set-receive-buffer-size!", "udp?", 0, argc, argv);
+
+  if (!SCHEME_INTP(argv[1]) || (SCHEME_INT_VAL(argv[1]) <= 0)) {
+    scheme_wrong_contract("udp-set-receive-buffer-size!", "exact-positive-integer?", 1, argc, argv);
+    return NULL;
+  }
+
+  udp_check_open("udp-set-receive-buffer-size!", argc, argv);
+
+  if (!rktio_udp_set_receive_buffer_size(scheme_rktio, udp->s, SCHEME_INT_VAL(argv[1])))
+    scheme_raise_exn(MZEXN_FAIL_NETWORK,
+                     "udp-set-receive-buffer-size!: setsockopt failed\n"
+                     "  system error: %R");
+
+  return scheme_void;
+}
+
 /*========================================================================*/
 /*                       precise GC traversers                            */
 /*========================================================================*/

racket/src/racket/src/schminc.h

@@ -14,7 +14,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 1449
+#define EXPECTED_PRIM_COUNT 1450
 
 #ifdef MZSCHEME_SOMETHING_OMITTED
 # undef USE_COMPILED_STARTUP

racket/src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "7.1.0.10"
+#define MZSCHEME_VERSION "7.1.0.11"
 
 #define MZSCHEME_VERSION_X 7
 #define MZSCHEME_VERSION_Y 1
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 10
+#define MZSCHEME_VERSION_W 11
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

racket/src/rktio/rktio.def

@@ -19,6 +19,7 @@ rktio_close_noerr
 rktio_dup
 rktio_forget
 rktio_std_fd
+rktio_create_console
 rktio_read
 rktio_write
 rktio_read_converted
@@ -61,6 +62,7 @@ rktio_udp_sendto
 rktio_udp_sendto_in
 rktio_udp_recvfrom
 rktio_udp_recvfrom_in
+rktio_udp_set_receive_buffer_size
 rktio_udp_get_multicast_loopback
 rktio_udp_set_multicast_loopback
 rktio_udp_get_multicast_ttl

racket/src/rktio/rktio.h

@@ -488,6 +488,8 @@ RKTIO_EXTERN rktio_length_and_addrinfo_t *rktio_udp_recvfrom_in(rktio_t *rktio,
                                                                 char *buffer, intptr_t start, intptr_t end);
 /* Like `rktio_udp_recvfrom`, but with starting and ending offsets. */
 
+RKTIO_EXTERN rktio_ok_t rktio_udp_set_receive_buffer_size(rktio_t *rktio, rktio_fd_t *rfd, int size);
+
 RKTIO_EXTERN_ERR(RKTIO_PROP_ERROR) rktio_tri_t rktio_udp_get_multicast_loopback(rktio_t *rktio, rktio_fd_t *rfd);
 RKTIO_EXTERN rktio_ok_t rktio_udp_set_multicast_loopback(rktio_t *rktio, rktio_fd_t *rfd, rktio_bool_t on);
 RKTIO_EXTERN_ERR(RKTIO_PROP_ERROR) rktio_tri_t rktio_udp_get_multicast_ttl(rktio_t *rktio, rktio_fd_t *rfd);

racket/src/rktio/rktio.inc

@@ -19,6 +19,7 @@ Sforeign_symbol("rktio_close_noerr", (void *)rktio_close_noerr);
 Sforeign_symbol("rktio_dup", (void *)rktio_dup);
 Sforeign_symbol("rktio_forget", (void *)rktio_forget);
 Sforeign_symbol("rktio_std_fd", (void *)rktio_std_fd);
+Sforeign_symbol("rktio_create_console", (void *)rktio_create_console);
 Sforeign_symbol("rktio_read", (void *)rktio_read);
 Sforeign_symbol("rktio_write", (void *)rktio_write);
 Sforeign_symbol("rktio_read_converted", (void *)rktio_read_converted);
@@ -61,6 +62,7 @@ Sforeign_symbol("rktio_udp_sendto", (void *)rktio_udp_sendto);
 Sforeign_symbol("rktio_udp_sendto_in", (void *)rktio_udp_sendto_in);
 Sforeign_symbol("rktio_udp_recvfrom", (void *)rktio_udp_recvfrom);
 Sforeign_symbol("rktio_udp_recvfrom_in", (void *)rktio_udp_recvfrom_in);
+Sforeign_symbol("rktio_udp_set_receive_buffer_size", (void *)rktio_udp_set_receive_buffer_size);
 Sforeign_symbol("rktio_udp_get_multicast_loopback", (void *)rktio_udp_get_multicast_loopback);
 Sforeign_symbol("rktio_udp_set_multicast_loopback", (void *)rktio_udp_set_multicast_loopback);
 Sforeign_symbol("rktio_udp_get_multicast_ttl", (void *)rktio_udp_get_multicast_ttl);

racket/src/rktio/rktio.rktl

@@ -294,6 +294,7 @@
  (ref rktio_fd_t)
  rktio_std_fd
  (((ref rktio_t) rktio) (int which)))
+(define-function () void rktio_create_console ())
 (define-function/errno
  RKTIO_READ_ERROR
  ()
@@ -583,6 +584,12 @@
   ((*ref char) buffer)
   (intptr_t start)
   (intptr_t end)))
+(define-function/errno
+ #f
+ ()
+ rktio_ok_t
+ rktio_udp_set_receive_buffer_size
+ (((ref rktio_t) rktio) ((ref rktio_fd_t) rfd) (int size)))
 (define-function/errno
  RKTIO_PROP_ERROR
  ()

racket/src/rktio/rktio_network.c

@@ -1888,6 +1888,20 @@ rktio_length_and_addrinfo_t *rktio_udp_recvfrom_in(rktio_t *rktio, rktio_fd_t *r
   return rktio_udp_recvfrom(rktio, rfd, buffer + start, end - start);
 }
 
+int rktio_udp_set_receive_buffer_size(rktio_t *rktio, rktio_fd_t *rfd, int size)
+{
+  rktio_socket_t s = rktio_fd_socket(rktio, rfd);
+  int status;
+
+  status = setsockopt(s, SOL_SOCKET, SO_RCVBUF, (void *)&size, sizeof(size));
+
+  if (status) {
+    get_socket_error();
+    return 0;
+  } else
+    return 1;
+}
+
 int rktio_udp_get_multicast_loopback(rktio_t *rktio, rktio_fd_t *rfd)
 {
   rktio_socket_t s = rktio_fd_socket(rktio, rfd);