added udp-ttl and udp-set-ttl!

racket/collects/racket/udp.rkt

@@ -24,6 +24,8 @@
              udp-send-evt
              udp-send-to-evt
              udp-addresses
+             udp-ttl
+             udp-set-ttl!
              udp-multicast-loopback?
              udp-multicast-set-loopback!
              udp-multicast-ttl

racket/src/cs/primitive/network.ss

@@ -17,6 +17,8 @@
   [udp-close (known-procedure 2)]
   [udp-connect! (known-procedure 8)]
   [udp-connected? (known-procedure 2)]
+  [udp-set-ttl! (known-procedure 4)]
+  [udp-ttl (known-procedure 2)]
   [udp-multicast-interface (known-procedure 2)]
   [udp-multicast-join-group! (known-procedure 8)]
   [udp-multicast-leave-group! (known-procedure 8)]

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

@@ -151,3 +151,24 @@
   
 (define (udp-default-family)
   (rktio_get_ipv4_family rktio))
+
+;; ----------------------------------------
+
+(define/who (udp-ttl u)
+  (check who udp? u)
+  (atomically
+   (check-udp-closed who u)
+   (define v (rktio_udp_ttl rktio (udp-s u)))
+   (cond
+     [(rktio-error? v)
+      (raise-option-error who "get" v)]
+     [else v])))
+
+(define/who (udp-set-ttl! u ttl)
+  (check who udp? u)
+  (check who byte? ttl)
+  (atomically
+   (check-udp-closed who u)
+   (define r (rktio_udp_set_ttl rktio (udp-s u) ttl))
+   (when (rktio-error? r)
+     (raise-option-error who "set" r))))

racket/src/racket/src/network.c

@@ -76,6 +76,8 @@ static Scheme_Object *udp_write_ready_evt(int argc, Scheme_Object *argv[]);
 static Scheme_Object *udp_read_evt(int argc, Scheme_Object *argv[]);
 static Scheme_Object *udp_write_evt(int argc, Scheme_Object *argv[]);
 static Scheme_Object *udp_write_to_evt(int argc, Scheme_Object *argv[]);
+static Scheme_Object *udp_ttl(int argc, Scheme_Object *argv[]);
+static Scheme_Object *udp_set_ttl(int argc, Scheme_Object *argv[]);
 static Scheme_Object *udp_multicast_loopback_p(int argc, Scheme_Object *argv[]);
 static Scheme_Object *udp_multicast_set_loopback(int argc, Scheme_Object *argv[]);
 static Scheme_Object *udp_multicast_ttl(int argc, Scheme_Object *argv[]);
@@ -139,6 +141,9 @@ void scheme_init_network(Scheme_Startup_Env *env)
   ADD_PRIM_W_ARITY  ( "udp-send-evt"              , udp_write_evt            , 2 , 4 , env) ;
   ADD_PRIM_W_ARITY  ( "udp-send-to-evt"           , udp_write_to_evt         , 4 , 6 , env) ;
 
+  ADD_PRIM_W_ARITY  ( "udp-ttl"                   , udp_ttl        , 1 , 1 , env) ;
+  ADD_PRIM_W_ARITY  ( "udp-set-ttl!"              , udp_set_ttl    , 2 , 2 , env) ;
+
   ADD_PRIM_W_ARITY  ( "udp-multicast-loopback?"   , udp_multicast_loopback_p , 1 , 1 , env) ;
   ADD_PRIM_W_ARITY  ( "udp-multicast-set-loopback!", udp_multicast_set_loopback,2, 2 , env) ;
   ADD_PRIM_W_ARITY  ( "udp-multicast-ttl"         , udp_multicast_ttl        , 1 , 1 , env) ;
@@ -2435,6 +2440,48 @@ static void udp_check_open(char const *name, int argc, Scheme_Object *argv[])
   }
 }
 
+static Scheme_Object *
+udp_ttl(int argc, Scheme_Object *argv[])
+{
+  Scheme_UDP *udp = (Scheme_UDP *) argv[0];
+  int r;
+
+  udp_check_open("udp-ttl", argc, argv);
+
+  r = rktio_udp_get_ttl(scheme_rktio, udp->s);
+
+  if (r == RKTIO_PROP_ERROR)
+    scheme_raise_exn(MZEXN_FAIL_NETWORK,
+                     "udp-ttl: getsockopt failed\n"
+                     "  system error: %R");
+
+  return scheme_make_integer(r);
+}
+
+static Scheme_Object *
+udp_set_ttl(int argc, Scheme_Object *argv[])
+{
+  Scheme_UDP *udp = (Scheme_UDP *)argv[0];
+
+  if (!SCHEME_UDPP(argv[0]))
+    scheme_wrong_contract("udp-set-ttl!", "udp?", 0, argc, argv);
+
+  if (!SCHEME_INTP(argv[1]) || (SCHEME_INT_VAL(argv[1]) < 0) || (SCHEME_INT_VAL(argv[1]) >= 256)) {
+    scheme_wrong_contract("udp-set-ttl!", "byte?", 1, argc, argv);
+    return NULL;
+  }
+
+  udp_check_open("udp-set-ttl!", argc, argv);
+
+  if (!rktio_udp_set_ttl(scheme_rktio, udp->s, SCHEME_INT_VAL(argv[1])))
+    scheme_raise_exn(MZEXN_FAIL_NETWORK,
+                     "udp-set-ttl!: setsockopt failed\n"
+                     "  system error: %R");
+
+  return scheme_void;
+}
+
+
 static Scheme_Object *
 udp_multicast_loopback_p(int argc, Scheme_Object *argv[])
 {

racket/src/racket/src/schminc.h

@@ -14,7 +14,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 1456
+#define EXPECTED_PRIM_COUNT 1458
 
 #ifdef MZSCHEME_SOMETHING_OMITTED
 # undef USE_COMPILED_STARTUP

racket/src/racket/src/schvers.h

@@ -16,7 +16,7 @@
 #define MZSCHEME_VERSION_X 7
 #define MZSCHEME_VERSION_Y 5
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 4
+#define MZSCHEME_VERSION_W 5
 
 /* A level of indirection makes `#` work as needed: */
 #define AS_a_STR_HELPER(x) #x

racket/src/rktio/rktio.def

@@ -55,6 +55,8 @@ rktio_connect_stop
 rktio_poll_connect_ready
 rktio_connect_trying
 rktio_socket_shutdown
+rktio_udp_get_ttl
+rktio_udp_set_ttl
 rktio_udp_open
 rktio_udp_disconnect
 rktio_udp_bind

racket/src/rktio/rktio.h

@@ -499,9 +499,14 @@ RKTIO_EXTERN rktio_length_and_addrinfo_t *rktio_udp_recvfrom_in(rktio_t *rktio,
 
 RKTIO_EXTERN rktio_ok_t rktio_udp_set_receive_buffer_size(rktio_t *rktio, rktio_fd_t *rfd, int size);
 
+RKTIO_EXTERN rktio_ok_t rktio_udp_set_ttl(rktio_t *rktio, rktio_fd_t *rfd, int ttl_val);
+RKTIO_EXTERN_ERR(RKTIO_PROP_ERROR) rktio_tri_t rktio_udp_get_ttl(rktio_t *rktio, rktio_fd_t *rfd);
+
+
 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);
+
 RKTIO_EXTERN rktio_ok_t rktio_udp_set_multicast_ttl(rktio_t *rktio, rktio_fd_t *rfd, int ttl_val);
 
 #define RKTIO_PROP_ERROR (-2)

racket/src/rktio/rktio.inc

@@ -64,6 +64,8 @@ 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_ttl", (void *)rktio_udp_get_ttl);
+Sforeign_symbol("rktio_udp_set_ttl", (void *)rktio_udp_set_ttl);
 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_network.c

@@ -1952,6 +1952,38 @@ int rktio_udp_set_multicast_loopback(rktio_t *rktio, rktio_fd_t *rfd, int on)
     return 1;
 }
 
+int rktio_udp_get_ttl(rktio_t *rktio, rktio_fd_t *rfd)
+{
+  rktio_socket_t s = rktio_fd_socket(rktio, rfd);
+  u_char ttl;
+  rktio_sockopt_len_t ttl_len = sizeof(ttl);
+  int status;
+
+  status = getsockopt(s, IPPROTO_IP, IP_TTL, (void *)&ttl, &ttl_len);
+
+  if (status) {
+    get_socket_error();
+    return RKTIO_PROP_ERROR;
+  } else
+    return ttl;
+}
+
+int rktio_udp_set_ttl(rktio_t *rktio, rktio_fd_t *rfd, int ttl_val)
+{
+  rktio_socket_t s = rktio_fd_socket(rktio, rfd);
+  u_char ttl = ttl_val;
+  rktio_sockopt_len_t ttl_len = sizeof(ttl);
+  int status;
+
+  status = setsockopt(s, IPPROTO_IP, IP_TTL, (void *)&ttl, ttl_len);
+
+  if (status) {
+    get_socket_error();
+    return 0;
+  } else
+    return 1;
+}
+
 int rktio_udp_get_multicast_ttl(rktio_t *rktio, rktio_fd_t *rfd)
 {
   rktio_socket_t s = rktio_fd_socket(rktio, rfd);