Back to index

plt-scheme  4.2.1
Defines | Functions
network.c File Reference
#include "schpriv.h"
#include <ctype.h>

Go to the source code of this file.

Defines

#define DECL_OS_FDSET(n)   DECL_FDSET(n, 1)
#define INIT_DECL_OS_FDSET(n)   INIT_DECL_FDSET(n, 1)
#define MZ_OS_FD_ZERO(p)   MZ_FD_ZERO(p)
#define MZ_OS_FD_SET(n, p)   MZ_FD_SET(n, p)
#define MZ_OS_FD_CLR(n, p)   MZ_FD_CLR(n, p)
#define MZ_OS_FD_ISSET(n, p)   FD_ISSET(n, p)
#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 OK_DISCONNECT_ERROR(e)   ((e) == mz_AFNOSUPPORT)

Functions

static Scheme_Objecttcp_connect (int argc, Scheme_Object *argv[])
static Scheme_Objecttcp_connect_break (int argc, Scheme_Object *argv[])
static Scheme_Objecttcp_listen (int argc, Scheme_Object *argv[])
static Scheme_Objecttcp_stop (int argc, Scheme_Object *argv[])
static Scheme_Objecttcp_accept_ready (int argc, Scheme_Object *argv[])
static Scheme_Objecttcp_accept (int argc, Scheme_Object *argv[])
static Scheme_Objecttcp_accept_evt (int argc, Scheme_Object *argv[])
static Scheme_Objecttcp_accept_break (int argc, Scheme_Object *argv[])
static Scheme_Objecttcp_listener_p (int argc, Scheme_Object *argv[])
static Scheme_Objecttcp_addresses (int argc, Scheme_Object *argv[])
static Scheme_Objecttcp_abandon_port (int argc, Scheme_Object *argv[])
static Scheme_Objecttcp_port_p (int argc, Scheme_Object *argv[])
static Scheme_Objectmake_udp (int argc, Scheme_Object *argv[])
static Scheme_Objectudp_close (int argc, Scheme_Object *argv[])
static Scheme_Objectudp_p (int argc, Scheme_Object *argv[])
static Scheme_Objectudp_bound_p (int argc, Scheme_Object *argv[])
static Scheme_Objectudp_connected_p (int argc, Scheme_Object *argv[])
static Scheme_Objectudp_bind (int argc, Scheme_Object *argv[])
static Scheme_Objectudp_connect (int argc, Scheme_Object *argv[])
static Scheme_Objectudp_send_to (int argc, Scheme_Object *argv[])
static Scheme_Objectudp_send (int argc, Scheme_Object *argv[])
static Scheme_Objectudp_send_to_star (int argc, Scheme_Object *argv[])
static Scheme_Objectudp_send_star (int argc, Scheme_Object *argv[])
static Scheme_Objectudp_send_to_enable_break (int argc, Scheme_Object *argv[])
static Scheme_Objectudp_send_enable_break (int argc, Scheme_Object *argv[])
static Scheme_Objectudp_receive (int argc, Scheme_Object *argv[])
static Scheme_Objectudp_receive_star (int argc, Scheme_Object *argv[])
static Scheme_Objectudp_receive_enable_break (int argc, Scheme_Object *argv[])
static Scheme_Objectudp_read_ready_evt (int argc, Scheme_Object *argv[])
static Scheme_Objectudp_write_ready_evt (int argc, Scheme_Object *argv[])
static Scheme_Objectudp_read_evt (int argc, Scheme_Object *argv[])
static Scheme_Objectudp_write_evt (int argc, Scheme_Object *argv[])
static Scheme_Objectudp_write_to_evt (int argc, Scheme_Object *argv[])
static int tcp_check_accept_evt (Scheme_Object *ae, Scheme_Schedule_Info *sinfo)
static void tcp_accept_evt_needs_wakeup (Scheme_Object *_ae, void *fds)
static void register_tcp_listener_sync ()
void scheme_init_network (Scheme_Env *env)
const char * scheme_hostname_error (int err)
static Scheme_Objectdo_tcp_accept (int argc, Scheme_Object *argv[], Scheme_Object *cust, char **_fail_reason)
void scheme_getnameinfo (void *sa, int salen, char *host, int hostlen, char *serv, int servlen)
static int extract_svc_value (char *svc_buf)
static Scheme_Objectaccept_failed (void *msg, int argc, Scheme_Object **argv)
int scheme_get_port_socket (Scheme_Object *p, long *_s)
void scheme_socket_to_ports (long s, const char *name, int takeover, Scheme_Object **_inp, Scheme_Object **_outp)
static Scheme_Objectudp_bind_or_connect (const char *name, int argc, Scheme_Object *argv[], int do_bind)
static Scheme_Objectdo_udp_send_it (const char *name, Scheme_UDP *udp, char *bstr, long start, long end, char *dest_addr, int dest_addr_len, int can_block)
static Scheme_Objectudp_send_it (const char *name, int argc, Scheme_Object *argv[], int with_addr, int can_block, Scheme_UDP_Evt *fill_evt)
static int do_udp_recv (const char *name, Scheme_UDP *udp, char *bstr, long start, long end, int can_block, Scheme_Object **v)
static Scheme_Objectudp_recv (const char *name, int argc, Scheme_Object *argv[], int can_block, Scheme_UDP_Evt *fill_evt)
static Scheme_Objectmake_udp_evt (const char *name, int argc, Scheme_Object **argv, int for_read)

Define Documentation

#define CHECK_PORT_ID (   obj)    (SCHEME_INTP(obj) && (SCHEME_INT_VAL(obj) >= 1) && (SCHEME_INT_VAL(obj) <= 65535))

Definition at line 419 of file network.c.

#define DECL_OS_FDSET (   n)    DECL_FDSET(n, 1)

Definition at line 165 of file network.c.

#define INIT_DECL_OS_FDSET (   n)    INIT_DECL_FDSET(n, 1)

Definition at line 166 of file network.c.

#define MZ_OS_FD_CLR (   n,
  p 
)    MZ_FD_CLR(n, p)

Definition at line 169 of file network.c.

#define MZ_OS_FD_ISSET (   n,
  p 
)    FD_ISSET(n, p)

Definition at line 171 of file network.c.

#define MZ_OS_FD_SET (   n,
  p 
)    MZ_FD_SET(n, p)

Definition at line 168 of file network.c.

#define MZ_OS_FD_ZERO (   p)    MZ_FD_ZERO(p)

Definition at line 167 of file network.c.

#define OK_DISCONNECT_ERROR (   e)    ((e) == mz_AFNOSUPPORT)

Definition at line 2780 of file network.c.

#define PORT_ID_TYPE   "exact integer in [1, 65535]"

Definition at line 418 of file network.c.


Function Documentation

static Scheme_Object* accept_failed ( void msg,
int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 2506 of file network.c.

{
  scheme_raise_exn(MZEXN_FAIL_NETWORK, msg ? (const char *)msg : "accept failed");
  return NULL;
} 

Here is the caller graph for this function:

static Scheme_Object* do_tcp_accept ( int  argc,
Scheme_Object argv[],
Scheme_Object cust,
char **  _fail_reason 
) [static]

Definition at line 2184 of file network.c.

{
#ifdef USE_TCP
  int was_closed = 0, errid, ready_pos;
  Scheme_Object *listener;
# ifdef USE_SOCKETS_TCP
  tcp_t s, ls;
  unsigned int l;
  GC_CAN_IGNORE char tcp_accept_addr[MZ_SOCK_NAME_MAX_LEN];
# endif

  if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_listener_type))
    scheme_wrong_type("tcp-accept", "tcp-listener", 0, argc, argv);

  TCP_INIT("tcp-accept");

  listener = argv[0];

  was_closed = LISTENER_WAS_CLOSED(listener);

  if (!was_closed) {
    ready_pos = tcp_check_accept(listener);
    if (!ready_pos) {
      scheme_block_until(tcp_check_accept, tcp_accept_needs_wakeup, listener, 0.0);
      ready_pos = tcp_check_accept(listener);
    }
    was_closed = LISTENER_WAS_CLOSED(listener);
  } else
    ready_pos = 0;

  if (was_closed) {
    if (_fail_reason)
      *_fail_reason = "tcp-accept-evt: listener is closed";
    else
      scheme_raise_exn(MZEXN_FAIL_NETWORK,
                       "tcp-accept: listener is closed");
    return NULL;
  }

  if (!_fail_reason)
    scheme_custodian_check_available((Scheme_Custodian *)cust, "tcp-accept", "network");
  else {
    if (!scheme_custodian_is_available((Scheme_Custodian *)cust)) {
      *_fail_reason = "tcp-accept-evt: custodian is shutdown";
      return NULL;
    }
  }
  
# ifdef USE_SOCKETS_TCP
  ls = ((listener_t *)listener)->s[ready_pos-1];

  l = sizeof(tcp_accept_addr);

  do {
    s = accept(ls, (struct sockaddr *)tcp_accept_addr, &l);
  } while ((s == -1) && (NOT_WINSOCK(errno) == EINTR));

  if (s != INVALID_SOCKET) {
    Scheme_Object *v[2];
    Scheme_Tcp *tcp;
    
#  ifdef USE_UNIX_SOCKETS_TCP
    int size = TCP_SOCKSENDBUF_SIZE;
#   ifndef CANT_SET_SOCKET_BUFSIZE
    setsockopt(s, SOL_SOCKET, SO_SNDBUF, (char *)&size, sizeof(int));
#   endif
#  endif

    tcp = make_tcp_port_data(s, 2);

    v[0] = make_tcp_input_port(tcp, "tcp-accepted", cust);
    v[1] = make_tcp_output_port(tcp, "tcp-accepted", cust);

    scheme_file_open_count++;
    REGISTER_SOCKET(s);
    
    return scheme_values(2, v);
  }
  errid = SOCK_ERRNO();
# endif
  
  if (_fail_reason)
    *_fail_reason = "tcp-accept-evt: accept from listener failed";
  else
    scheme_raise_exn(MZEXN_FAIL_NETWORK,
                     "tcp-accept: accept from listener failed (%E)", errid);
#else
  scheme_wrong_type("tcp-accept", "tcp-listener", 0, argc, argv);
#endif

  return NULL;
}

Here is the caller graph for this function:

static int do_udp_recv ( const char *  name,
Scheme_UDP *  udp,
char *  bstr,
long  start,
long  end,
int  can_block,
Scheme_Object **  v 
) [static]

Definition at line 3212 of file network.c.

{
#ifdef UDP_IS_SUPPORTED
  long x;
  int errid = 0;
  char src_addr[MZ_SOCK_NAME_MAX_LEN];
  unsigned int asize = sizeof(src_addr);

  if (!udp->bound) {
    scheme_raise_exn(MZEXN_FAIL_NETWORK,
                   "%s: udp socket is not bound: %V",
                   name,
                   udp);
    return 0;
  }

  while (1) {
    if (udp->s == INVALID_SOCKET) {
      /* socket was closed, maybe while we slept */
      scheme_raise_exn(MZEXN_FAIL_NETWORK,
                     "%s: udp socket is closed: %V",
                     name, udp);
      return 0;
    }

    {
      x = recvfrom(udp->s, bstr XFORM_OK_PLUS start, end - start, 0,
                 (struct sockaddr *)src_addr, &asize);
    }

    if (x == -1) {
      errid = SOCK_ERRNO();
      if (WAS_WSAEMSGSIZE(errid)) {
       x = end - start;
       errid = 0;
      } if (WAS_EAGAIN(errid)) {
       if (can_block) {
         /* Block and eventually try again. */
         scheme_block_until(udp_check_recv, udp_recv_needs_wakeup, (Scheme_Object *)udp, 0);
       } else {
         v[0] = scheme_false;
         v[1] = scheme_false;
         v[2] = scheme_false;
         return 0;
       }
      } else if (NOT_WINSOCK(errid) != EINTR)
       break;
    } else
      break;
  }
  
  if (x > -1) {
    char host_buf[MZ_SOCK_HOST_NAME_MAX_LEN];
    char prev_buf[MZ_SOCK_HOST_NAME_MAX_LEN];
    char svc_buf[MZ_SOCK_SVC_NAME_MAX_LEN];
    int j, id;

    v[0] = scheme_make_integer(x);

    scheme_getnameinfo((struct sockaddr *)src_addr, asize,
                     host_buf, sizeof(host_buf),
                     svc_buf, sizeof(svc_buf));
    
    if (udp->previous_from_addr) {
      mzchar *s;
      s = SCHEME_CHAR_STR_VAL(udp->previous_from_addr);
      for (j = 0; s[j]; j++) {
       prev_buf[j] = (char)s[j];
      }
      prev_buf[j] = 0;
    }

    if (udp->previous_from_addr && !strcmp(prev_buf, host_buf)) {
      v[1] = udp->previous_from_addr;
    } else {
      Scheme_Object *vv;
      vv = scheme_make_immutable_sized_utf8_string(host_buf, -1);
      v[1] = vv;
      udp->previous_from_addr = v[1];
    }

    id = extract_svc_value(svc_buf);

    v[2] = scheme_make_integer(id);

    return 1;
  } else {
    scheme_raise_exn(MZEXN_FAIL_NETWORK,
                   "%s: receive failed (%E)", 
                   name,
                   errid);
    return 0;
  }
#else
  return 0;
#endif
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* do_udp_send_it ( const char *  name,
Scheme_UDP *  udp,
char *  bstr,
long  start,
long  end,
char *  dest_addr,
int  dest_addr_len,
int  can_block 
) [static]

Definition at line 2979 of file network.c.

{
  long x;
  int errid = 0;

  while (1) {
    if (udp->s == INVALID_SOCKET) {
      /* socket was closed, maybe while we slept */
      scheme_raise_exn(MZEXN_FAIL_NETWORK,
                     "%s: udp socket is closed: %V",
                     name, udp);
      return NULL;
    }
    if ((!dest_addr && !udp->connected)
       || (dest_addr && udp->connected)) {
      /* socket is unconnected, maybe disconnected while we slept */
      scheme_raise_exn(MZEXN_FAIL_NETWORK,
                     "%s: udp socket is%s connected: %V",
                     name, 
                     dest_addr ? "" : " not",
                     udp);
      return NULL;
    }

    udp->bound = 1; /* in case it's not bound already, send[to] binds it */

    if (dest_addr)
      x = sendto(udp->s, bstr XFORM_OK_PLUS start, end - start, 
               0, (struct sockaddr *)dest_addr, dest_addr_len);
    else
      x = send(udp->s, bstr XFORM_OK_PLUS start, end - start, 0);

    if (x == -1) {
      errid = SOCK_ERRNO();
      if (WAS_EAGAIN(errid)) {
       if (can_block) {
         /* Block and eventually try again. */
         scheme_block_until(udp_check_send, udp_send_needs_wakeup, (Scheme_Object *)udp, 0);
       } else
         return scheme_false;
      } else if (NOT_WINSOCK(errid) != EINTR)
       break;
    } else if (x != (end - start)) {
      /* this isn't supposed to happen: */
      scheme_raise_exn(MZEXN_FAIL_NETWORK,
                     "%s: didn't send enough (%d != %d)", 
                     name,
                     x, end - start);
      return NULL;
    } else
      break;
  }
    
  if (x > -1) {
    return (can_block ? scheme_void : scheme_true);
  } else {
    scheme_raise_exn(MZEXN_FAIL_NETWORK,
                   "%s: send failed (%E)", 
                   name,
                   errid);
    return NULL;
  }
}

Here is the caller graph for this function:

static int extract_svc_value ( char *  svc_buf) [static]

Definition at line 2329 of file network.c.

{
  int id = 0, j;
  for (j = 0; svc_buf[j]; j++) {
    id = (id * 10) + (svc_buf[j] - '0');
  }
  return id;
}

Here is the caller graph for this function:

static Scheme_Object * make_udp ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2628 of file network.c.

{
#ifdef UDP_IS_SUPPORTED
  Scheme_UDP *udp;
  tcp_t s;
  char *address = "";
  unsigned short origid, id;

  TCP_INIT("udp-open-socket");

  if ((argc > 0) && !SCHEME_FALSEP(argv[0]) && !SCHEME_CHAR_STRINGP(argv[0]))
    scheme_wrong_type("udp-open-socket", "string or #f", 0, argc, argv);
  if ((argc > 1) && !SCHEME_FALSEP(argv[1]) && !CHECK_PORT_ID(argv[1]))
    scheme_wrong_type("udp-open-socket", PORT_ID_TYPE " or #f", 1, argc, argv);

  if ((argc > 0) && SCHEME_TRUEP(argv[0])) {
    Scheme_Object *bs;
    bs = scheme_char_string_to_byte_string(argv[0]);
    address = SCHEME_BYTE_STR_VAL(bs);
  } else
    address = NULL;
  if ((argc > 1) && SCHEME_TRUEP(argv[1]))
    origid = (unsigned short)SCHEME_INT_VAL(argv[1]);
  else
    origid = 0;

  scheme_security_check_network("udp-open-socket", address, origid, 0);
  scheme_custodian_check_available(NULL, "udp-open-socket", "network");

  if (address || origid) {
    int err;
    GC_CAN_IGNORE struct mz_addrinfo *udp_bind_addr = NULL;
    if (!origid)
      origid = 1025;
    id = origid;
    udp_bind_addr = scheme_get_host_address(address, id, &err, -1, 1, 0);
    if (!udp_bind_addr) {
      scheme_raise_exn(MZEXN_FAIL_NETWORK,
                     "udp-open-socket: can't resolve address: %s (%N)", 
                     address ? address : "<unspec>", 1, err);
      return NULL;
    }
    s = socket(udp_bind_addr->ai_family,
              udp_bind_addr->ai_socktype,
              udp_bind_addr->ai_protocol);
    mz_freeaddrinfo(udp_bind_addr);
  } else {
    s = socket(MZ_PF_INET, SOCK_DGRAM, 0);
  }

  if (s == INVALID_SOCKET) {
    int errid;
    errid = SOCK_ERRNO();
    scheme_raise_exn(MZEXN_FAIL_NETWORK,
                   "udp-open-socket: creation failed (%E)", errid);
    return NULL;
  }

  udp = MALLOC_ONE_TAGGED(Scheme_UDP);
  udp->so.type = scheme_udp_type;
  udp->s = s;
  udp->bound = 0;
  udp->connected = 0;
  udp->previous_from_addr = NULL;

#ifdef USE_WINSOCK_TCP
  {
    unsigned long ioarg = 1;
    BOOL bc = 1;
    ioctlsocket(s, FIONBIO, &ioarg);
    setsockopt(s, SOL_SOCKET, SO_BROADCAST, (char *)(&bc), sizeof(BOOL));
  }
#else
  fcntl(s, F_SETFL, MZ_NONBLOCKING);
# ifdef SO_BROADCAST
  {
    int bc = 1;
    setsockopt(s, SOL_SOCKET, SO_BROADCAST, &bc, sizeof(bc));
  }
# endif
#endif

  {
    Scheme_Custodian_Reference *mref;
    mref = scheme_add_managed(NULL,
                           (Scheme_Object *)udp,
                           (Scheme_Close_Custodian_Client *)udp_close_it,
                           NULL,
                           1);
    udp->mref = mref;
  }

  return (Scheme_Object *)udp;
#else
  scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
                 "udp-open-socket: not supported on this platform");
  return NULL;
#endif
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* make_udp_evt ( const char *  name,
int  argc,
Scheme_Object **  argv,
int  for_read 
) [static]

Definition at line 3355 of file network.c.

{
#ifdef UDP_IS_SUPPORTED
  Scheme_UDP_Evt *uw;
#endif

  if (!SCHEME_UDPP(argv[0]))
    scheme_wrong_type(name, "udp socket", 0, argc, argv);

#ifdef UDP_IS_SUPPORTED
  uw = MALLOC_ONE_TAGGED(Scheme_UDP_Evt);
  uw->so.type = scheme_udp_evt_type;
  uw->udp = (Scheme_UDP *)argv[0];
  uw->for_read = for_read;

  return (Scheme_Object *)uw;
#else
  return scheme_void;
#endif
}

Here is the caller graph for this function:

static void register_tcp_listener_sync ( ) [static]

Definition at line 2290 of file network.c.

{
#ifdef USE_TCP
  scheme_add_evt(scheme_listener_type, tcp_check_accept, tcp_accept_needs_wakeup, NULL, 0);
  scheme_add_evt(scheme_tcp_accept_evt_type, (Scheme_Ready_Fun)tcp_check_accept_evt, tcp_accept_evt_needs_wakeup, NULL, 0);
# ifdef UDP_IS_SUPPORTED
  scheme_add_evt(scheme_udp_evt_type, (Scheme_Ready_Fun)udp_evt_check_ready, udp_evt_needs_wakeup, NULL, 0);
# endif
#endif
}

Here is the call graph for this function:

Here is the caller graph for this function:

int scheme_get_port_socket ( Scheme_Object p,
long *  _s 
)

Definition at line 2539 of file network.c.

{
#ifdef USE_TCP
  tcp_t s = 0;
  int s_ok = 0;

  if (SCHEME_OUTPUT_PORTP(p)) {
    Scheme_Output_Port *op;
    op = scheme_output_port_record(p);
    if (op->sub_type == scheme_tcp_output_port_type) {
      if (!op->closed) {
       s = ((Scheme_Tcp *)op->port_data)->tcp;
       s_ok = 1;
      }
    }
  } else if (SCHEME_INPUT_PORTP(p)) {
    Scheme_Input_Port *ip;
    ip = scheme_input_port_record(p);
    if (ip->sub_type == scheme_tcp_input_port_type) {
      if (!ip->closed) {
       s = ((Scheme_Tcp *)ip->port_data)->tcp;
       s_ok = 1;
      }
    }
  }

  if (s_ok) {
    *_s = (long)s;
    return 1;
  } else
    return 0;
#endif
}
void scheme_getnameinfo ( void sa,
int  salen,
char *  host,
int  hostlen,
char *  serv,
int  servlen 
)

Definition at line 2308 of file network.c.

{
#ifdef HAVE_GETADDRINFO
  getnameinfo(sa, salen, host, hostlen, serv, servlen,
             NI_NUMERICHOST | NI_NUMERICSERV);
#else
  if (host) {
    unsigned char *b;
    b = (unsigned char *)&((struct sockaddr_in *)sa)->sin_addr;
    sprintf(host, "%d.%d.%d.%d", b[0], b[1], b[2], b[3]);
  }
  if (serv) {
    int id;
    id = ntohs(((struct sockaddr_in *)sa)->sin_port);
    sprintf(serv, "%d", id);
  }
#endif
}

Definition at line 1650 of file network.c.

{
#ifdef USE_SOCKETS_TCP
  return mz_gai_strerror(err);
#else
  return "?";
#endif
}

Here is the caller graph for this function:

Definition at line 221 of file network.c.

{
  Scheme_Env *netenv;

#ifdef MZ_PRECISE_GC
  register_traversers();
#endif

  netenv = scheme_primitive_module(scheme_intern_symbol("#%network"), env);

  scheme_add_global_constant("tcp-connect", 
                          scheme_make_prim_w_arity2(tcp_connect,
                                                 "tcp-connect", 
                                                 2, 4,
                                                 2, 2), 
                          netenv);
  scheme_add_global_constant("tcp-connect/enable-break", 
                          scheme_make_prim_w_arity2(tcp_connect_break,
                                                 "tcp-connect/enable-break", 
                                                 2, 4,
                                                 2, 2), 
                          netenv);
  scheme_add_global_constant("tcp-listen", 
                          scheme_make_prim_w_arity(tcp_listen,
                                                "tcp-listen", 
                                                1, 4),
                          netenv);
  scheme_add_global_constant("tcp-close", 
                          scheme_make_prim_w_arity(tcp_stop,
                                                "tcp-close", 
                                                1, 1), 
                          netenv);
  scheme_add_global_constant("tcp-accept-ready?", 
                          scheme_make_prim_w_arity(tcp_accept_ready,
                                                "tcp-accept-ready?", 
                                                1, 1), 
                          netenv);
  scheme_add_global_constant("tcp-accept", 
                          scheme_make_prim_w_arity2(tcp_accept,
                                                 "tcp-accept", 
                                                 1, 1,
                                                 2, 2), 
                          netenv);
  scheme_add_global_constant("tcp-accept-evt", 
                          scheme_make_prim_w_arity(tcp_accept_evt,
                                                "tcp-accept-evt", 
                                                1, 1), 
                          netenv);
  scheme_add_global_constant("tcp-accept/enable-break", 
                          scheme_make_prim_w_arity2(tcp_accept_break,
                                                 "tcp-accept/enable-break", 
                                                 1, 1,
                                                 2, 2), 
                          netenv);
  scheme_add_global_constant("tcp-listener?", 
                          scheme_make_folding_prim(tcp_listener_p,
                                                "tcp-listener?", 
                                                1, 1, 1), 
                          netenv);
  scheme_add_global_constant("tcp-addresses", 
                          scheme_make_prim_w_arity2(tcp_addresses,
                                                 "tcp-addresses", 
                                                 1, 2,
                                                 2, 4), 
                          netenv);
  scheme_add_global_constant("tcp-abandon-port", 
                          scheme_make_prim_w_arity(tcp_abandon_port,
                                                "tcp-abandon-port", 
                                                1, 1), 
                          netenv);
  scheme_add_global_constant("tcp-port?", 
                          scheme_make_folding_prim(tcp_port_p,
                                                "tcp-port?", 
                                                1, 1, 1), 
                          netenv);

  scheme_add_global_constant("udp-open-socket", 
                          scheme_make_prim_w_arity(make_udp,
                                                "udp-open-socket", 
                                                0, 2), 
                          netenv);
  scheme_add_global_constant("udp-close", 
                          scheme_make_prim_w_arity(udp_close,
                                                "udp-close", 
                                                1, 1), 
                          netenv);
  scheme_add_global_constant("udp?", 
                          scheme_make_folding_prim(udp_p,
                                                "udp?", 
                                                1, 1, 1), 
                          netenv);
  scheme_add_global_constant("udp-bound?", 
                          scheme_make_prim_w_arity(udp_bound_p,
                                                "udp-bound?", 
                                                1, 1), 
                          netenv);
  scheme_add_global_constant("udp-connected?", 
                          scheme_make_prim_w_arity(udp_connected_p,
                                                "udp-connected?", 
                                                1, 1), 
                          netenv);

  scheme_add_global_constant("udp-bind!", 
                          scheme_make_prim_w_arity(udp_bind,
                                                "udp-bind!", 
                                                3, 3), 
                          netenv);
  scheme_add_global_constant("udp-connect!", 
                          scheme_make_prim_w_arity(udp_connect,
                                                "udp-connect!", 
                                                3, 3), 
                          netenv);

  scheme_add_global_constant("udp-send-to", 
                          scheme_make_prim_w_arity(udp_send_to,
                                                "udp-send-to", 
                                                4, 6), 
                          netenv);
  scheme_add_global_constant("udp-send", 
                          scheme_make_prim_w_arity(udp_send,
                                                "udp-send", 
                                                2, 4), 
                          netenv);
  scheme_add_global_constant("udp-send-to*", 
                          scheme_make_prim_w_arity(udp_send_to_star,
                                                "udp-send-to*", 
                                                4, 6), 
                          netenv);
  scheme_add_global_constant("udp-send*", 
                          scheme_make_prim_w_arity(udp_send_star,
                                                "udp-send*", 
                                                2, 4), 
                          netenv);
  scheme_add_global_constant("udp-send-to/enable-break", 
                          scheme_make_prim_w_arity(udp_send_to_enable_break,
                                                "udp-send-to/enable-break", 
                                                4, 6), 
                          netenv);
  scheme_add_global_constant("udp-send/enable-break", 
                          scheme_make_prim_w_arity(udp_send_enable_break,
                                                "udp-send/enable-break", 
                                                2, 4), 
                          netenv);

  scheme_add_global_constant("udp-receive!", 
                          scheme_make_prim_w_arity(udp_receive,
                                                "udp-receive!", 
                                                2, 4), 
                          netenv);
  scheme_add_global_constant("udp-receive!*", 
                          scheme_make_prim_w_arity(udp_receive_star,
                                                "udp-receive!*", 
                                                2, 4), 
                          netenv);
  scheme_add_global_constant("udp-receive!/enable-break", 
                          scheme_make_prim_w_arity(udp_receive_enable_break,
                                                "udp-receive!/enable-break", 
                                                2, 4), 
                          netenv);
  scheme_add_global_constant("udp-receive-ready-evt", 
                          scheme_make_prim_w_arity(udp_read_ready_evt,
                                                "udp-receive-ready-evt", 
                                                1, 1), 
                          netenv);
  scheme_add_global_constant("udp-send-ready-evt", 
                          scheme_make_prim_w_arity(udp_write_ready_evt,
                                                "udp-send-ready-evt", 
                                                1, 1), 
                          netenv);
  scheme_add_global_constant("udp-receive!-evt", 
                          scheme_make_prim_w_arity(udp_read_evt,
                                                "udp-receive!-evt", 
                                                2, 4), 
                          netenv);
  scheme_add_global_constant("udp-send-evt", 
                          scheme_make_prim_w_arity(udp_write_evt,
                                                "udp-send-evt", 
                                                2, 4), 
                          netenv);
  scheme_add_global_constant("udp-send-to-evt", 
                          scheme_make_prim_w_arity(udp_write_to_evt,
                                                "udp-send-to-evt", 
                                                4, 6), 
                          netenv);

  register_tcp_listener_sync();

  scheme_finish_primitive_module(netenv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

void scheme_socket_to_ports ( long  s,
const char *  name,
int  takeover,
Scheme_Object **  _inp,
Scheme_Object **  _outp 
)

Definition at line 2573 of file network.c.

{
  Scheme_Tcp *tcp;
  Scheme_Object *v;

  tcp = make_tcp_port_data(s, takeover ? 2 : 3);

  v = make_tcp_input_port(tcp, name, NULL);
  *_inp = v;
  v = make_tcp_output_port(tcp, name, NULL);
  *_outp = v;
  
  if (takeover) {
    scheme_file_open_count++;
    REGISTER_SOCKET(s);
  }
}
static Scheme_Object * tcp_abandon_port ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2432 of file network.c.

{
#ifdef USE_TCP
  if (SCHEME_OUTPUT_PORTP(argv[0])) {
    Scheme_Output_Port *op;
    op = scheme_output_port_record(argv[0]);
    if (op->sub_type == scheme_tcp_output_port_type) {
      if (!op->closed) {
       ((Scheme_Tcp *)op->port_data)->flags |= MZ_TCP_ABANDON_OUTPUT;
       scheme_close_output_port(argv[0]);
      }
      return scheme_void;
    }
  } else if (SCHEME_INPUT_PORTP(argv[0])) {
    /* Abandon is not really useful on input ports from the Schemer's
       perspective, but it's here for completeness. */
    Scheme_Input_Port *ip;
    ip = scheme_input_port_record(argv[0]);
    if (ip->sub_type == scheme_tcp_input_port_type) {
      if (!ip->closed) {
       ((Scheme_Tcp *)ip->port_data)->flags |= MZ_TCP_ABANDON_INPUT;
       scheme_close_input_port(argv[0]);
      }
      return scheme_void;
    }
  }
#endif

  scheme_wrong_type("tcp-abandon-port", "tcp-port", 0, argc, argv);

  return NULL;
}

Here is the caller graph for this function:

static Scheme_Object * tcp_accept ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2279 of file network.c.

{
  return do_tcp_accept(argc, argv, NULL, NULL);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * tcp_accept_break ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2285 of file network.c.

{
  return scheme_call_enable_break(tcp_accept, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * tcp_accept_evt ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2487 of file network.c.

{
  Scheme_Object *r, *custodian;

  if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_listener_type))
    scheme_wrong_type("tcp-accept-evt", "tcp-listener", 0, argc, argv);

  custodian = scheme_get_param(scheme_current_config(), MZCONFIG_CUSTODIAN);

  scheme_custodian_check_available((Scheme_Custodian *)custodian, "tcp-accept", "network");
  
  r = scheme_alloc_object();
  r->type = scheme_tcp_accept_evt_type;
  SCHEME_PTR1_VAL(r) = argv[0];
  SCHEME_PTR2_VAL(r) = custodian;

  return r;
}

Here is the caller graph for this function:

static void tcp_accept_evt_needs_wakeup ( Scheme_Object _ae,
void fds 
) [static]

Definition at line 2534 of file network.c.

{
  tcp_accept_needs_wakeup(SCHEME_PTR1_VAL(ae), fds);
}

Here is the caller graph for this function:

static Scheme_Object * tcp_accept_ready ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2158 of file network.c.

{
#ifdef USE_TCP
  int ready;

  if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_listener_type))
    scheme_wrong_type("tcp-accept-ready?", "tcp-listener", 0, argc, argv);

  TCP_INIT("tcp-accept-ready?");

  if (LISTENER_WAS_CLOSED(argv[0])) {
    scheme_raise_exn(MZEXN_FAIL_NETWORK,
                   "tcp-accept-ready?: listener is closed");
    return NULL;
  }

  ready = tcp_check_accept(argv[0]);

  return (ready ? scheme_true : scheme_false);
#else
  scheme_wrong_type("tcp-accept-ready?", "tcp-listener", 0, argc, argv);
  return NULL;
#endif
}

Here is the caller graph for this function:

static Scheme_Object * tcp_addresses ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2338 of file network.c.

{
#ifdef USE_TCP
  Scheme_Tcp *tcp = NULL;
  int closed = 0;
  Scheme_Object *result[4];
  int with_ports = 0;

  if (SCHEME_OUTPUT_PORTP(argv[0])) {
    Scheme_Output_Port *op;
    op = scheme_output_port_record(argv[0]);
    if (op->sub_type == scheme_tcp_output_port_type)
      tcp = op->port_data;
    closed = op->closed;
  } else if (SCHEME_INPUT_PORTP(argv[0])) {
    Scheme_Input_Port *ip;
    ip = scheme_input_port_record(argv[0]);
    if (ip->sub_type == scheme_tcp_input_port_type)
      tcp = ip->port_data;
    closed = ip->closed;
  }

  if (argc > 1)
    with_ports = SCHEME_TRUEP(argv[1]);

  if (!tcp)
    scheme_wrong_type("tcp-addresses", "tcp-port", 0, argc, argv);

  if (closed)
    scheme_raise_exn(MZEXN_FAIL_NETWORK,
                   "tcp-addresses: port is closed");

# ifdef USE_SOCKETS_TCP
  {
    unsigned int l;
    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;

    l = sizeof(here);
    if (getsockname(tcp->tcp, (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());
    }
    there_len = l;

    scheme_getnameinfo((struct sockaddr *)here, here_len, 
                     host_buf, sizeof(host_buf),
                       (with_ports ? svc_buf : NULL), 
                       (with_ports ? sizeof(svc_buf) : 0));
    result[0] = scheme_make_utf8_string(host_buf);
    if (with_ports) {
      l = extract_svc_value(svc_buf);
      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);
    }
  }
# else
  result[0] = scheme_make_utf8_string("0.0.0.0");
  if (with_ports) {
    result[1] = scheme_make_integer(1);
    result[2] = result[0];
    result[3] = result[1];
  } else {
    result[1] = result[0];
  }
# endif

  return scheme_values(with_ports ? 4 : 2, result);
#else
  /* First arg can't possibly be right! */
  scheme_wrong_type("tcp-addresses", "tcp-port", 0, argc, argv);
#endif
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int tcp_check_accept_evt ( Scheme_Object ae,
Scheme_Schedule_Info sinfo 
) [static]

Definition at line 2512 of file network.c.

{
  if (tcp_check_accept(SCHEME_PTR1_VAL(ae))) {
    Scheme_Object *a[2];
    char *fail_reason = NULL;
    a[0] = SCHEME_PTR1_VAL(ae);
    if (do_tcp_accept(1, a, SCHEME_PTR2_VAL(ae), &fail_reason)) {
      a[0] = scheme_current_thread->ku.multiple.array[0];
      a[1] = scheme_current_thread->ku.multiple.array[1];
      scheme_set_sync_target(sinfo, scheme_build_list(2, a), NULL, NULL, 0, 0, NULL);
      return 1;
    } else {
      /* error on accept */
      scheme_set_sync_target(sinfo, scheme_always_ready_evt, 
                             scheme_make_closed_prim(accept_failed, fail_reason), 
                             NULL, 0, 0, NULL);
      return 1;
    }
  } else
    return 0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * tcp_connect ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1659 of file network.c.

{
  char * volatile address = "", * volatile src_address, * volatile errmsg = "";
  unsigned short origid, id, src_origid, src_id;
  int errpart = 0, errid = 0;
  volatile int nameerr = 0, no_local_spec;
  Scheme_Object *bs, *src_bs;
#ifdef USE_SOCKETS_TCP
  GC_CAN_IGNORE struct mz_addrinfo *tcp_connect_dest;
  GC_CAN_IGNORE struct mz_addrinfo * volatile tcp_connect_src;
#endif

  if (!SCHEME_CHAR_STRINGP(argv[0]))
    scheme_wrong_type("tcp-connect", "string", 0, argc, argv);
  if (!CHECK_PORT_ID(argv[1]))
    scheme_wrong_type("tcp-connect", PORT_ID_TYPE, 1, argc, argv);
  if (argc > 2)
    if (!SCHEME_CHAR_STRINGP(argv[2]) && !SCHEME_FALSEP(argv[2]))
      scheme_wrong_type("tcp-connect", "string or #f", 2, argc, argv);
  if (argc > 3)
    if (SCHEME_TRUEP(argv[3]) && !CHECK_PORT_ID(argv[3]))
      scheme_wrong_type("tcp-connect", PORT_ID_TYPE " or #f", 3, argc, argv);

#ifdef USE_TCP
  TCP_INIT("tcp-connect");
#endif

  bs = argv[0];
  if (SCHEME_CHAR_STRINGP(bs))
    bs = scheme_char_string_to_byte_string(bs);

  address = SCHEME_BYTE_STR_VAL(bs);
  origid = (unsigned short)SCHEME_INT_VAL(argv[1]);

  if ((argc > 2) && SCHEME_TRUEP(argv[2])) {
    src_bs = scheme_char_string_to_byte_string(argv[2]);
    src_address = SCHEME_BYTE_STR_VAL(src_bs);
  } else
    src_address = NULL;
   
  if ((argc > 3) && SCHEME_TRUEP(argv[3])) {
    no_local_spec = 0;
    src_origid = (unsigned short)SCHEME_INT_VAL(argv[3]);
  } else {
    no_local_spec = 1;
    src_origid = 0;
    if (src_address) {
      scheme_arg_mismatch("tcp-connect",
                       "no local port number supplied when local hostname was supplied: ",
                       argv[2]);
    }
  }

  scheme_security_check_network("tcp-connect", address, origid, 1);
  scheme_custodian_check_available(NULL, "tcp-connect", "network");

#ifdef USE_TCP
  id = origid;
  src_id = src_origid;
#endif

#ifdef USE_SOCKETS_TCP
  tcp_connect_dest = scheme_get_host_address(address, id, &errid, -1, 0, 1);
  if (tcp_connect_dest) {
    if (no_local_spec)
      tcp_connect_src = NULL;
    else
      tcp_connect_src = scheme_get_host_address(src_address, src_id, &errid, -1, 1, 1);
    if (no_local_spec || tcp_connect_src) {
      GC_CAN_IGNORE struct mz_addrinfo * volatile addr;
      for (addr = tcp_connect_dest; addr; addr = addr->ai_next) {
       tcp_t s;
       s = socket(addr->ai_family, addr->ai_socktype, addr->ai_protocol);
       if (s != INVALID_SOCKET) {
         int status, inprogress;
         if (no_local_spec
             || !bind(s, tcp_connect_src->ai_addr, tcp_connect_src->ai_addrlen)) {
#ifdef USE_WINSOCK_TCP
           unsigned long ioarg = 1;
           ioctlsocket(s, FIONBIO, &ioarg);
#else
           int size = TCP_SOCKSENDBUF_SIZE;
           fcntl(s, F_SETFL, MZ_NONBLOCKING);
# ifndef CANT_SET_SOCKET_BUFSIZE
           setsockopt(s, SOL_SOCKET, SO_SNDBUF, (char *)&size, sizeof(int));
# endif
#endif
           status = connect(s, addr->ai_addr, addr->ai_addrlen);
#ifdef USE_UNIX_SOCKETS_TCP
           if (status)
             status = errno;
           if (status == EINTR)
             status = EINPROGRESS;
       
           inprogress = (status == EINPROGRESS);
#endif
#ifdef USE_WINSOCK_TCP
           if (status)
             status = WSAGetLastError();

           inprogress = (status == WSAEWOULDBLOCK);
           errno = status;
#endif

           scheme_file_open_count++;
         
           if (inprogress) {
             tcp_t *sptr;
             Close_Socket_Data *csd;

             sptr = (tcp_t *)scheme_malloc_atomic(sizeof(tcp_t));
             *sptr = s;

             csd = (Close_Socket_Data *)scheme_malloc_atomic(sizeof(Close_Socket_Data));
             csd->s = s;
             csd->src_addr = tcp_connect_src;
             csd->dest_addr = tcp_connect_dest;

             BEGIN_ESCAPEABLE(closesocket_w_decrement, csd);
             scheme_block_until(tcp_check_connect, tcp_connect_needs_wakeup, (void *)sptr, (float)0.0);
             END_ESCAPEABLE();

             /* Check whether connect succeeded, or get error: */
             {
              unsigned int so_len = sizeof(status);
              if (getsockopt(s, SOL_SOCKET, SO_ERROR, (void *)&status, &so_len) != 0) {
                status = SOCK_ERRNO();
              }
              errno = status; /* for error reporting, below */
             }

#ifdef USE_WINSOCK_TCP
             if (scheme_stupid_windows_machine > 0) {
              /* getsockopt() seems not to work in Windows 95, so use the
                 result from select(), which seems to reliably detect an error condition */
              if (!status) {
                if (tcp_check_connect((Scheme_Object *)sptr) == -1) {
                  status = 1;
                  errno = WSAECONNREFUSED; /* guess! */
                }
              }
             }
#endif
           }
       
           if (!status) {
             Scheme_Object *v[2];
             Scheme_Tcp *tcp;

             if (tcp_connect_src)
              mz_freeaddrinfo(tcp_connect_src);
             mz_freeaddrinfo(tcp_connect_dest);

             tcp = make_tcp_port_data(s, 2);
             
             v[0] = make_tcp_input_port(tcp, address, NULL);
             v[1] = make_tcp_output_port(tcp, address, NULL);
             
             REGISTER_SOCKET(s);

             return scheme_values(2, v);
           } else {
             errid = errno;
             closesocket(s);
             --scheme_file_open_count;
             errpart = 6;
           }
         } else {
           errpart = 5;
           errid = SOCK_ERRNO();
         }
       } else {
         errpart = 4;
         errid = SOCK_ERRNO();
       }
      }
      if (tcp_connect_src)
       mz_freeaddrinfo(tcp_connect_src);
    } else {
      errpart = 2;
      nameerr = 1;
      errmsg = "; local host not found";
    } 
    if (tcp_connect_dest)
      mz_freeaddrinfo(tcp_connect_dest);
  } else {
    errpart = 1;
    nameerr = 1;
    errmsg = "; host not found";
  }
#endif

#ifdef USE_TCP
  scheme_raise_exn(MZEXN_FAIL_NETWORK,
                 "tcp-connect: connection to %s, port %d failed%s (at step %d: %N)",
                 address, origid, errmsg, errpart, nameerr, errid);
#else
  scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
                 "tcp-connect: not supported on this platform");
#endif

  return NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * tcp_connect_break ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1864 of file network.c.

{
  return scheme_call_enable_break(tcp_connect, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * tcp_listen ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 1870 of file network.c.

{
  unsigned short id, origid;
  int backlog, errid;
  int reuse = 0;
#ifdef MZ_TCP_LISTEN_IPV6_ONLY_SOCKOPT
  int no_ipv6 = 0;
#endif
  const char *address;
  
  if (!CHECK_PORT_ID(argv[0]))
    scheme_wrong_type("tcp-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);
  }
  if (argc > 2)
    reuse = SCHEME_TRUEP(argv[2]);
  if (argc > 3) {
    if (!SCHEME_CHAR_STRINGP(argv[3]) && !SCHEME_FALSEP(argv[3]))
      scheme_wrong_type("tcp-listen", "string or #f", 3, argc, argv);
  }
    
#ifdef USE_TCP
  TCP_INIT("tcp-listen");
#endif

  origid = (unsigned short)SCHEME_INT_VAL(argv[0]);
  if (argc > 1)
    backlog = SCHEME_INT_VAL(argv[1]);
  else
    backlog = 4;
  if ((argc > 3) && SCHEME_TRUEP(argv[3])) {
    Scheme_Object *bs;
    bs = scheme_char_string_to_byte_string(argv[3]);
    address = SCHEME_BYTE_STR_VAL(bs);
  } else
    address = NULL;

  scheme_security_check_network("tcp-listen", address, origid, 0);
  scheme_custodian_check_available(NULL, "tcp-listen", "network");

#ifdef USE_TCP
  id = origid;
#endif

#ifdef MZ_TCP_LISTEN_IPV6_ONLY_SOCKOPT
 retry:
#endif

  {
    GC_CAN_IGNORE struct mz_addrinfo *tcp_listen_addr, *addr;
    int err, count = 0, pos = 0, i;
    listener_t *l = NULL;
#ifdef MZ_TCP_LISTEN_IPV6_ONLY_SOCKOPT
    int any_v4 = 0, any_v6 = 0;
#endif

    tcp_listen_addr = scheme_get_host_address(address, id, &err, 
#ifdef MZ_TCP_LISTEN_IPV6_ONLY_SOCKOPT
                                         no_ipv6 ? MZ_PF_INET : -1,
#else
                                         -1, 
#endif
                                         1, 1);

    for (addr = tcp_listen_addr; addr; addr = addr->ai_next) {
#ifdef MZ_TCP_LISTEN_IPV6_ONLY_SOCKOPT
      if (addr->ai_family == MZ_PF_INET)
       any_v4 = 1;
      else if (addr->ai_family == PF_INET6)
       any_v6 = 1;
#endif
      count++;
    }
              
    if (tcp_listen_addr) {
      tcp_t s;
#ifdef MZ_TCP_LISTEN_IPV6_ONLY_SOCKOPT
      /* Try IPv6 listeners first, so we can retry and use just IPv4 if
        IPv6 doesn't work right. */
      int v6_loop = (any_v6 && any_v4), skip_v6 = 0;
#endif

      errid = 0;
      for (addr = tcp_listen_addr; addr; ) {
#ifdef MZ_TCP_LISTEN_IPV6_ONLY_SOCKOPT
       if ((v6_loop && (addr->ai_family != PF_INET6))
           || (skip_v6 && (addr->ai_family == PF_INET6))) {
         addr = addr->ai_next;
         if (v6_loop && !addr) {
           v6_loop = 0;
           skip_v6 = 1;
           addr = tcp_listen_addr;
         }
         continue;
       }
#endif

       s = socket(addr->ai_family, addr->ai_socktype, addr->ai_protocol);

#ifdef MZ_TCP_LISTEN_IPV6_ONLY_SOCKOPT
       if (s == INVALID_SOCKET) {
         /* Maybe it failed because IPv6 is not available: */
         if ((addr->ai_family == PF_INET6) && (errno == EAFNOSUPPORT)) {
           if (any_v4 && !pos) {
             /* Maybe we can make it work with just IPv4. Try again. */
             no_ipv6 = 1;
             mz_freeaddrinfo(tcp_listen_addr);
             goto retry;
           }
         }
       }
       if (s != INVALID_SOCKET) {
         if (any_v4 && (addr->ai_family == PF_INET6)) {
           int ok;
# ifdef IPV6_V6ONLY
           int on = 1;
           ok = setsockopt(s, IPPROTO_IPV6, IPV6_V6ONLY, &on, sizeof(on));
# else
           ok = -1;
# endif
           if (ok) {
             if (!pos) {
              /* IPV6_V6ONLY doesn't work */
              no_ipv6 = 1;
              mz_freeaddrinfo(tcp_listen_addr);
              goto retry;
             } else {
              errid = errno;
              closesocket(s);
              errno = errid;
              s = INVALID_SOCKET;
             }
           }
         }
       }
#endif

       if (s != INVALID_SOCKET) {
#ifdef USE_WINSOCK_TCP
         unsigned long ioarg = 1;
         ioctlsocket(s, FIONBIO, &ioarg);
#else
         fcntl(s, F_SETFL, MZ_NONBLOCKING);
#endif

         if (reuse) {
           setsockopt(s, SOL_SOCKET, SO_REUSEADDR, (char *)(&reuse), sizeof(int));
         }
      
         if (!bind(s, addr->ai_addr, addr->ai_addrlen)) {
           if (!listen(s, backlog)) {
             if (!pos) {
              l = scheme_malloc_tagged(sizeof(listener_t) + ((count - 1) * sizeof(tcp_t)));
              l->so.type = scheme_listener_type;
              l->count = count;
              {
                Scheme_Custodian_Reference *mref;
                mref = scheme_add_managed(NULL,
                                       (Scheme_Object *)l,
                                       (Scheme_Close_Custodian_Client *)stop_listener,
                                       NULL,
                                       1);
                l->mref = mref;
              }
             }
             l->s[pos++] = s;
           
             scheme_file_open_count++;
             REGISTER_SOCKET(s);

             if (pos == count) {
              mz_freeaddrinfo(tcp_listen_addr);

              return (Scheme_Object *)l;
             }
           } else {
             errid = SOCK_ERRNO();
             closesocket(s);
             break;
           }
         } else {
           errid = SOCK_ERRNO();
           closesocket(s);
           break;
         }
       } else {
         errid = SOCK_ERRNO();
         break;
       }

       addr = addr->ai_next;

#ifdef MZ_TCP_LISTEN_IPV6_ONLY_SOCKOPT
       if (!addr && v6_loop) {
         v6_loop = 0;
         skip_v6 = 1;
         addr = tcp_listen_addr;
       }
#endif
      }

      for (i = 0; i < pos; i++) {
       s = l->s[i];
       UNREGISTER_SOCKET(s);
       closesocket(s);
       --scheme_file_open_count;
      }
      
      mz_freeaddrinfo(tcp_listen_addr);
    } else {
      scheme_raise_exn(MZEXN_FAIL_NETWORK,
                     "tcp-listen: host not found: %s (%N)",
                     address, 1, err);
      return NULL;
    }
  }

#ifdef USE_TCP
  scheme_raise_exn(MZEXN_FAIL_NETWORK,
                 "tcp-listen: listen on %d failed (%E)",
                 origid, errid);
#else
  scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
                 "tcp-listen: not supported on this platform");
#endif

  return NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * tcp_listener_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2301 of file network.c.

Here is the caller graph for this function:

static Scheme_Object * tcp_port_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2465 of file network.c.

{
#ifdef USE_TCP
  if (SCHEME_OUTPUT_PORTP(argv[0])) {
    Scheme_Output_Port *op;
    op = scheme_output_port_record(argv[0]);
    if (op->sub_type == scheme_tcp_output_port_type) {
      return scheme_true;
    }
  } else if (SCHEME_INPUT_PORTP(argv[0])) {
    Scheme_Input_Port *ip;
    ip = scheme_input_port_record(argv[0]);
    if (ip->sub_type == scheme_tcp_input_port_type) {
      return scheme_true;
    }
  }
#endif

  return scheme_false;
}

Here is the caller graph for this function:

static Scheme_Object * tcp_stop ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2132 of file network.c.

{
#ifdef USE_TCP
  int was_closed;

  if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_listener_type))
    scheme_wrong_type("tcp-close", "tcp-listener", 0, argc, argv);

  TCP_INIT("tcp-close");

  was_closed = stop_listener(argv[0]);

  if (was_closed) {
    scheme_raise_exn(MZEXN_FAIL_NETWORK,
                   "tcp-close: listener was already closed");
    return NULL;
  }

  return scheme_void;
#else
  scheme_wrong_type("tcp-close", "tcp-listener", 0, argc, argv);
  return NULL;
#endif
}

Here is the caller graph for this function:

static Scheme_Object * udp_bind ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2923 of file network.c.

{
  return udp_bind_or_connect("udp-bind!", argc, argv, 1);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* udp_bind_or_connect ( const char *  name,
int  argc,
Scheme_Object argv[],
int  do_bind 
) [static]

Definition at line 2783 of file network.c.

{
#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;

  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]);
  }

  scheme_security_check_network(name, address, origid, !do_bind);

  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;
  }

  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;

#ifdef USE_NULL_TO_DISCONNECT_UDP
      if (!origid) {
       if (udp->connected)
         ok = !connect(udp->s, NULL, 0);
      } else
#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) {
       if (origid)
         udp->connected = 1;
       else
         udp->connected = 0;
       if (udp_bind_addr)
         mz_freeaddrinfo(udp_bind_addr);
       return scheme_void;
      }
    }

    if (udp_bind_addr)
      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;
  }
#else
  return scheme_void;
#endif
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * udp_bound_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2752 of file network.c.

{
  if (!SCHEME_UDPP(argv[0]))
    scheme_wrong_type("udp-bound?", "udp socket", 0, argc, argv);

#ifdef UDP_IS_SUPPORTED
  return (((Scheme_UDP *)argv[0])->bound ? scheme_true : scheme_false);
#else
  return scheme_void;
#endif
}

Here is the caller graph for this function:

static Scheme_Object * udp_close ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2729 of file network.c.

{
  if (!SCHEME_UDPP(argv[0]))
    scheme_wrong_type("udp-close", "udp socket", 0, argc, argv);

#ifdef UDP_IS_SUPPORTED
  if (udp_close_it(argv[0])) {
    scheme_raise_exn(MZEXN_FAIL_NETWORK,
                   "udp-close: udp socket was already closed");
    return NULL;
  }
#endif

  return scheme_void;
}

Here is the caller graph for this function:

static Scheme_Object * udp_connect ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2928 of file network.c.

{
  return udp_bind_or_connect("udp-connect!", argc, argv, 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * udp_connected_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2765 of file network.c.

{
  if (!SCHEME_UDPP(argv[0]))
    scheme_wrong_type("udp-connected?", "udp socket", 0, argc, argv);

#ifdef UDP_IS_SUPPORTED
  return (((Scheme_UDP *)argv[0])->connected ? scheme_true : scheme_false);
#else
  return scheme_void;
#endif
}

Here is the caller graph for this function:

static Scheme_Object * udp_p ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 2746 of file network.c.

{
  return (SCHEME_UDPP(argv[0]) ? scheme_true : scheme_false);
}

Here is the caller graph for this function:

static Scheme_Object * udp_read_evt ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3386 of file network.c.

{
  Scheme_Object *evt;
  evt = make_udp_evt("udp-receive!-evt", argc, argv, 1);
  udp_recv("udp-receive!-evt", argc, argv, 0, (Scheme_UDP_Evt *)evt);
  return evt;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * udp_read_ready_evt ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3376 of file network.c.

{
  return make_udp_evt("udp-receive-ready-evt", argc, argv, 1);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * udp_receive ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3340 of file network.c.

{
  return udp_recv("udp-receive!", argc, argv, 1, NULL);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * udp_receive_enable_break ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3350 of file network.c.

{
  return scheme_call_enable_break(udp_receive, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * udp_receive_star ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3345 of file network.c.

{
  return udp_recv("udp-receive!*", argc, argv, 0, NULL);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* udp_recv ( const char *  name,
int  argc,
Scheme_Object argv[],
int  can_block,
Scheme_UDP_Evt *  fill_evt 
) [static]

Definition at line 3311 of file network.c.

{
  Scheme_UDP *udp;
  long start, end;
  Scheme_Object *v[3];

  udp = (Scheme_UDP *)argv[0];

  if (!SCHEME_UDPP(argv[0]))
    scheme_wrong_type(name, "udp socket", 0, argc, argv);
  if (!SCHEME_BYTE_STRINGP(argv[1]) || !SCHEME_MUTABLEP(argv[1]))
    scheme_wrong_type(name, "mutable byte string", 1, argc, argv);
  
  scheme_get_substring_indices(name, argv[1], 
                            argc, argv,
                            2, 3, &start, &end);
  if (fill_evt) {
    fill_evt->str = SCHEME_BYTE_STR_VAL(argv[1]);
    fill_evt->offset = start;
    fill_evt->len = end - start;
    return scheme_void;
  } else {
    do_udp_recv(name, udp, SCHEME_BYTE_STR_VAL(argv[1]), start, end, can_block, v);
    
    return scheme_values(3,v);
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * udp_send ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3140 of file network.c.

{
  return udp_send_it("udp-send", argc, argv, 0, 1, NULL);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * udp_send_enable_break ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3160 of file network.c.

{
  return scheme_call_enable_break(udp_send, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* udp_send_it ( const char *  name,
int  argc,
Scheme_Object argv[],
int  with_addr,
int  can_block,
Scheme_UDP_Evt *  fill_evt 
) [static]

Definition at line 3045 of file network.c.

{
#ifdef UDP_IS_SUPPORTED
  Scheme_UDP *udp;
  char *address = "";
  long start, end;
  int delta, err;
  unsigned short origid, id;
  GC_CAN_IGNORE struct mz_addrinfo *udp_dest_addr;

  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 (with_addr) {
    if (!SCHEME_CHAR_STRINGP(argv[1]))
      scheme_wrong_type(name, "string", 1, argc, argv);
    if (!CHECK_PORT_ID(argv[2]))
      scheme_wrong_type(name, PORT_ID_TYPE, 2, argc, argv);
    delta = 0;
  } else
    delta = -2;

  if (!SCHEME_BYTE_STRINGP(argv[3 + delta]))
    scheme_wrong_type(name, "byte string", 3 + delta, argc, argv);
  
  scheme_get_substring_indices(name, argv[3 + delta], 
                            argc, argv,
                            4 + delta, 5 + delta, &start, &end);

  if (with_addr) {
    Scheme_Object *bs;
    bs = scheme_char_string_to_byte_string(argv[1]);
    address = SCHEME_BYTE_STR_VAL(bs);
    origid = (unsigned short)SCHEME_INT_VAL(argv[2]);

    scheme_security_check_network(name, address, origid, 1);

    id = origid;
  } else {
    address = NULL;
    id = origid = 0;
  }

  if (with_addr)
    udp_dest_addr = scheme_get_host_address(address, id, &err, -1, 0, 0);
  else
    udp_dest_addr = NULL;

  if (!with_addr || udp_dest_addr) {
    if (fill_evt) {
      char *s;
      fill_evt->str = SCHEME_BYTE_STR_VAL(argv[3+delta]);
      fill_evt->offset = start;
      fill_evt->len = end - start;
      if (udp_dest_addr) {
       s = (char *)scheme_malloc_atomic(udp_dest_addr->ai_addrlen);
       memcpy(s, udp_dest_addr->ai_addr, udp_dest_addr->ai_addrlen);
       fill_evt->dest_addr = s;
       fill_evt->dest_addr_len = udp_dest_addr->ai_addrlen;
       mz_freeaddrinfo(udp_dest_addr);
      }
      return scheme_void;
    } else {
      Scheme_Object *r;
      r = do_udp_send_it(name, udp,
                      SCHEME_BYTE_STR_VAL(argv[3+delta]), start, end,
                      (udp_dest_addr ? (char *)udp_dest_addr->ai_addr : NULL),
                      (udp_dest_addr ? udp_dest_addr->ai_addrlen : 0),
                      can_block);
      if (udp_dest_addr)
       mz_freeaddrinfo(udp_dest_addr);
      return r;
    }
  } else {
    scheme_raise_exn(MZEXN_FAIL_NETWORK,
                   "%s: can't resolve address: %s (%N)", 
                   name,
                   address, 1, err);
    return NULL;
  }
#else
  return scheme_void;
#endif
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * udp_send_star ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3150 of file network.c.

{
  return udp_send_it("udp-send*", argc, argv, 0, 0, NULL);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * udp_send_to ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3135 of file network.c.

{
  return udp_send_it("udp-send-to", argc, argv, 1, 1, NULL);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * udp_send_to_enable_break ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3155 of file network.c.

{
  return scheme_call_enable_break(udp_send_to, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * udp_send_to_star ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3145 of file network.c.

{
  return udp_send_it("udp-send-to*", argc, argv, 1, 0, NULL);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * udp_write_evt ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3394 of file network.c.

{
  Scheme_Object *evt;
  evt = make_udp_evt("udp-send-evt", argc, argv, 0);
  udp_send_it("udp-send-evt", argc, argv, 0, 0, (Scheme_UDP_Evt *)evt);
  return evt;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * udp_write_ready_evt ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3381 of file network.c.

{
  return make_udp_evt("udp-send-ready-evt", argc, argv, 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * udp_write_to_evt ( int  argc,
Scheme_Object argv[] 
) [static]

Definition at line 3402 of file network.c.

{
  Scheme_Object *evt;
  evt = make_udp_evt("udp-send-to-evt", argc, argv, 0);
  udp_send_it("udp-send-to-evt", argc, argv, 1, 0, (Scheme_UDP_Evt *)evt);
  ((Scheme_UDP_Evt *)evt)->with_addr = 1;
  return evt;
}

Here is the call graph for this function:

Here is the caller graph for this function: