guile18/libguile/socket.c

   1 /* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public
   5  * License as published by the Free Software Foundation; either
   6  * version 2.1 of the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  16  */
  17
  18
  19 \f
  20
  21 #ifdef HAVE_CONFIG_H
  22 #  include <config.h>
  23 #endif
  24
  25 #include <errno.h>
  26 #include <gmp.h>
  27
  28 #include "libguile/_scm.h"
  29 #include "libguile/unif.h"
  30 #include "libguile/feature.h"
  31 #include "libguile/fports.h"
  32 #include "libguile/strings.h"
  33 #include "libguile/vectors.h"
  34 #include "libguile/dynwind.h"
  35
  36 #include "libguile/validate.h"
  37 #include "libguile/socket.h"
  38
  39 #include "libguile/iselect.h"
  40
  41 #ifdef __MINGW32__
  42 #include "win32-socket.h"
  43 #endif
  44
  45 #ifdef HAVE_STDINT_H
  46 #include <stdint.h>
  47 #endif
  48 #ifdef HAVE_STRING_H
  49 #include <string.h>
  50 #endif
  51 #ifdef HAVE_UNISTD_H
  52 #include <unistd.h>
  53 #endif
  54 #include <sys/types.h>
  55 #ifdef HAVE_WINSOCK2_H
  56 #include <winsock2.h>
  57 #else
  58 #include <sys/socket.h>
  59 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
  60 #include <sys/un.h>
  61 #endif
  62 #include <netinet/in.h>
  63 #include <netdb.h>
  64 #include <arpa/inet.h>
  65 #endif
  66
  67 #if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
  68 #define SUN_LEN(ptr) ((size_t) (((struct sockaddr_un *) 0)->sun_path) \
  69                       + strlen ((ptr)->sun_path))
  70 #endif
  71
  72 /* The largest possible socket address.  Wrapping it in a union guarantees
  73    that the compiler will make it suitably aligned.  */
  74 typedef union
  75 {
  76   struct sockaddr     sockaddr;
  77   struct sockaddr_in  sockaddr_in;
  78
  79 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
  80   struct sockaddr_un  sockaddr_un;
  81 #endif
  82 #ifdef HAVE_IPV6
  83   struct sockaddr_in6 sockaddr_in6;
  84 #endif
  85 } scm_t_max_sockaddr;
  86
  87
  88 /* Maximum size of a socket address.  */
  89 #define MAX_ADDR_SIZE   (sizeof (scm_t_max_sockaddr))
  90
  91
  92 \f
  93
  94 SCM_DEFINE (scm_htons, "htons", 1, 0, 0,
  95             (SCM value),
  96             "Convert a 16 bit quantity from host to network byte ordering.\n"
  97             "@var{value} is packed into 2 bytes, which are then converted\n"
  98             "and returned as a new integer.")
  99 #define FUNC_NAME s_scm_htons
 100 {
 101   return scm_from_ushort (htons (scm_to_ushort (value)));
 102 }
 103 #undef FUNC_NAME
 104
 105 SCM_DEFINE (scm_ntohs, "ntohs", 1, 0, 0,
 106             (SCM value),
 107             "Convert a 16 bit quantity from network to host byte ordering.\n"
 108             "@var{value} is packed into 2 bytes, which are then converted\n"
 109             "and returned as a new integer.")
 110 #define FUNC_NAME s_scm_ntohs
 111 {
 112   return scm_from_ushort (ntohs (scm_to_ushort (value)));
 113 }
 114 #undef FUNC_NAME
 115
 116 SCM_DEFINE (scm_htonl, "htonl", 1, 0, 0,
 117             (SCM value),
 118             "Convert a 32 bit quantity from host to network byte ordering.\n"
 119             "@var{value} is packed into 4 bytes, which are then converted\n"
 120             "and returned as a new integer.")
 121 #define FUNC_NAME s_scm_htonl
 122 {
 123   return scm_from_ulong (htonl (scm_to_uint32 (value)));
 124 }
 125 #undef FUNC_NAME
 126
 127 SCM_DEFINE (scm_ntohl, "ntohl", 1, 0, 0,
 128             (SCM value),
 129             "Convert a 32 bit quantity from network to host byte ordering.\n"
 130             "@var{value} is packed into 4 bytes, which are then converted\n"
 131             "and returned as a new integer.")
 132 #define FUNC_NAME s_scm_ntohl
 133 {
 134   return scm_from_ulong (ntohl (scm_to_uint32 (value)));
 135 }
 136 #undef FUNC_NAME
 137
 138 #ifndef HAVE_INET_ATON
 139 /* for our definition in inet_aton.c, not usually needed.  */
 140 extern int inet_aton ();
 141 #endif
 142
 143 SCM_DEFINE (scm_inet_aton, "inet-aton", 1, 0, 0,
 144             (SCM address),
 145             "Convert an IPv4 Internet address from printable string\n"
 146             "(dotted decimal notation) to an integer.  E.g.,\n\n"
 147             "@lisp\n"
 148             "(inet-aton \"127.0.0.1\") @result{} 2130706433\n"
 149             "@end lisp")
 150 #define FUNC_NAME s_scm_inet_aton
 151 {
 152   struct in_addr soka;
 153   char *c_address;
 154   int rv;
 155
 156   c_address = scm_to_locale_string (address);
 157   rv = inet_aton (c_address, &soka);
 158   free (c_address);
 159   if (rv == 0)
 160     SCM_MISC_ERROR ("bad address", SCM_EOL);
 161   return scm_from_ulong (ntohl (soka.s_addr));
 162 }
 163 #undef FUNC_NAME
 164
 165
 166 SCM_DEFINE (scm_inet_ntoa, "inet-ntoa", 1, 0, 0,
 167             (SCM inetid),
 168             "Convert an IPv4 Internet address to a printable\n"
 169             "(dotted decimal notation) string.  E.g.,\n\n"
 170             "@lisp\n"
 171             "(inet-ntoa 2130706433) @result{} \"127.0.0.1\"\n"
 172             "@end lisp")
 173 #define FUNC_NAME s_scm_inet_ntoa
 174 {
 175   struct in_addr addr;
 176   char *s;
 177   SCM answer;
 178   addr.s_addr = htonl (SCM_NUM2ULONG (1, inetid));
 179   s = inet_ntoa (addr);
 180   answer = scm_from_locale_string (s);
 181   return answer;
 182 }
 183 #undef FUNC_NAME
 184
 185 #ifdef HAVE_INET_NETOF
 186 SCM_DEFINE (scm_inet_netof, "inet-netof", 1, 0, 0,
 187             (SCM address),
 188             "Return the network number part of the given IPv4\n"
 189             "Internet address.  E.g.,\n\n"
 190             "@lisp\n"
 191             "(inet-netof 2130706433) @result{} 127\n"
 192             "@end lisp")
 193 #define FUNC_NAME s_scm_inet_netof
 194 {
 195   struct in_addr addr;
 196   addr.s_addr = htonl (SCM_NUM2ULONG (1, address));
 197   return scm_from_ulong (inet_netof (addr));
 198 }
 199 #undef FUNC_NAME
 200 #endif
 201
 202 #ifdef HAVE_INET_LNAOF
 203 SCM_DEFINE (scm_lnaof, "inet-lnaof", 1, 0, 0,
 204             (SCM address),
 205             "Return the local-address-with-network part of the given\n"
 206             "IPv4 Internet address, using the obsolete class A/B/C system.\n"
 207             "E.g.,\n\n"
 208             "@lisp\n"
 209             "(inet-lnaof 2130706433) @result{} 1\n"
 210             "@end lisp")
 211 #define FUNC_NAME s_scm_lnaof
 212 {
 213   struct in_addr addr;
 214   addr.s_addr = htonl (SCM_NUM2ULONG (1, address));
 215   return scm_from_ulong (inet_lnaof (addr));
 216 }
 217 #undef FUNC_NAME
 218 #endif
 219
 220 #ifdef HAVE_INET_MAKEADDR
 221 SCM_DEFINE (scm_inet_makeaddr, "inet-makeaddr", 2, 0, 0,
 222             (SCM net, SCM lna),
 223             "Make an IPv4 Internet address by combining the network number\n"
 224             "@var{net} with the local-address-within-network number\n"
 225             "@var{lna}.  E.g.,\n\n"
 226             "@lisp\n"
 227             "(inet-makeaddr 127 1) @result{} 2130706433\n"
 228             "@end lisp")
 229 #define FUNC_NAME s_scm_inet_makeaddr
 230 {
 231   struct in_addr addr;
 232   unsigned long netnum;
 233   unsigned long lnanum;
 234
 235   netnum = SCM_NUM2ULONG (1, net);
 236   lnanum = SCM_NUM2ULONG (2, lna);
 237   addr = inet_makeaddr (netnum, lnanum);
 238   return scm_from_ulong (ntohl (addr.s_addr));
 239 }
 240 #undef FUNC_NAME
 241 #endif
 242
 243 #ifdef HAVE_IPV6
 244
 245 /* flip a 128 bit IPv6 address between host and network order.  */
 246 #ifdef WORDS_BIGENDIAN
 247 #define FLIP_NET_HOST_128(addr)
 248 #else
 249 #define FLIP_NET_HOST_128(addr)\
 250 {\
 251   int i;\
 252   \
 253   for (i = 0; i < 8; i++)\
 254     {\
 255       scm_t_uint8 c = (addr)[i];\
 256       \
 257       (addr)[i] = (addr)[15 - i];\
 258       (addr)[15 - i] = c;\
 259     }\
 260 }
 261 #endif
 262
 263 #ifdef WORDS_BIGENDIAN
 264 #define FLIPCPY_NET_HOST_128(dest, src) memcpy (dest, src, 16)
 265 #else
 266 #define FLIPCPY_NET_HOST_128(dest, src) \
 267 { \
 268   const scm_t_uint8 *tmp_srcp = (src) + 15; \
 269   scm_t_uint8 *tmp_destp = (dest); \
 270   \
 271   do { \
 272     *tmp_destp++ = *tmp_srcp--; \
 273   } while (tmp_srcp != (src)); \
 274 }
 275 #endif
 276
 277
 278 #if (SIZEOF_SCM_T_BITS * SCM_CHAR_BIT) > 128
 279 #error "Assumption that scm_t_bits <= 128 bits has been violated."
 280 #endif
 281
 282 #if (SIZEOF_UNSIGNED_LONG * SCM_CHAR_BIT) > 128
 283 #error "Assumption that unsigned long <= 128 bits has been violated."
 284 #endif
 285
 286 #if (SIZEOF_UNSIGNED_LONG_LONG * SCM_CHAR_BIT) > 128
 287 #error "Assumption that unsigned long long <= 128 bits has been violated."
 288 #endif
 289
 290 /* convert a 128 bit IPv6 address in network order to a host ordered
 291    SCM integer.  */
 292 static SCM
 293 scm_from_ipv6 (const scm_t_uint8 *src)
 294 {
 295   SCM result = scm_i_mkbig ();
 296   mpz_import (SCM_I_BIG_MPZ (result),
 297               1,  /* chunk */
 298               1,  /* big-endian chunk ordering */
 299               16, /* chunks are 16 bytes long */
 300               1,  /* big-endian byte ordering */
 301               0,  /* "nails" -- leading unused bits per chunk */
 302               src);
 303   return scm_i_normbig (result);
 304 }
 305
 306 /* convert a host ordered SCM integer to a 128 bit IPv6 address in
 307    network order.  */
 308 static void
 309 scm_to_ipv6 (scm_t_uint8 dst[16], SCM src)
 310 {
 311   if (SCM_I_INUMP (src))
 312     {
 313       scm_t_signed_bits n = SCM_I_INUM (src);
 314       if (n < 0)
 315         scm_out_of_range (NULL, src);
 316 #ifdef WORDS_BIGENDIAN
 317       memset (dst, 0, 16 - sizeof (scm_t_signed_bits));
 318       memcpy (dst + (16 - sizeof (scm_t_signed_bits)),
 319               &n,
 320               sizeof (scm_t_signed_bits));
 321 #else
 322       memset (dst + sizeof (scm_t_signed_bits),
 323               0,
 324               16 - sizeof (scm_t_signed_bits));
 325       /* FIXME: this pair of ops is kinda wasteful -- should rewrite as
 326          a single loop perhaps, similar to the handling of bignums. */
 327       memcpy (dst, &n, sizeof (scm_t_signed_bits));
 328       FLIP_NET_HOST_128 (dst);
 329 #endif
 330     }
 331   else if (SCM_BIGP (src))
 332     {
 333       size_t count;
 334
 335       if ((mpz_sgn (SCM_I_BIG_MPZ (src)) < 0)
 336           || mpz_sizeinbase (SCM_I_BIG_MPZ (src), 2) > 128)
 337         scm_out_of_range (NULL, src);
 338
 339       memset (dst, 0, 16);
 340       mpz_export (dst,
 341                   &count,
 342                   1, /* big-endian chunk ordering */
 343                   16, /* chunks are 16 bytes long */
 344                   1, /* big-endian byte ordering */
 345                   0, /* "nails" -- leading unused bits per chunk */
 346                   SCM_I_BIG_MPZ (src));
 347       scm_remember_upto_here_1 (src);
 348     }
 349   else
 350     scm_wrong_type_arg_msg ("scm_to_ipv6", 0, src, "integer");
 351 }
 352
 353 #ifdef HAVE_INET_PTON
 354 SCM_DEFINE (scm_inet_pton, "inet-pton", 2, 0, 0,
 355             (SCM family, SCM address),
 356             "Convert a string containing a printable network address to\n"
 357             "an integer address.  Note that unlike the C version of this\n"
 358             "function,\n"
 359             "the result is an integer with normal host byte ordering.\n"
 360             "@var{family} can be @code{AF_INET} or @code{AF_INET6}.  E.g.,\n\n"
 361             "@lisp\n"
 362             "(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
 363             "(inet-pton AF_INET6 \"::1\") @result{} 1\n"
 364             "@end lisp")
 365 #define FUNC_NAME s_scm_inet_pton
 366 {
 367   int af;
 368   char *src;
 369   scm_t_uint32 dst[4];
 370   int rv, eno;
 371
 372   af = scm_to_int (family);
 373   SCM_ASSERT_RANGE (1, family, af == AF_INET || af == AF_INET6);
 374   src = scm_to_locale_string (address);
 375   rv = inet_pton (af, src, dst);
 376   eno = errno;
 377   free (src);
 378   errno = eno;
 379   if (rv == -1)
 380     SCM_SYSERROR;
 381   else if (rv == 0)
 382     SCM_MISC_ERROR ("Bad address", SCM_EOL);
 383   if (af == AF_INET)
 384     return scm_from_ulong (ntohl (*dst));
 385   else
 386     return scm_from_ipv6 ((scm_t_uint8 *) dst);
 387 }
 388 #undef FUNC_NAME
 389 #endif
 390
 391 #ifdef HAVE_INET_NTOP
 392 SCM_DEFINE (scm_inet_ntop, "inet-ntop", 2, 0, 0,
 393             (SCM family, SCM address),
 394             "Convert a network address into a printable string.\n"
 395             "Note that unlike the C version of this function,\n"
 396             "the input is an integer with normal host byte ordering.\n"
 397             "@var{family} can be @code{AF_INET} or @code{AF_INET6}.  E.g.,\n\n"
 398             "@lisp\n"
 399             "(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
 400             "(inet-ntop AF_INET6 (- (expt 2 128) 1))\n"
 401             "  @result{} \"ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\"\n"
 402             "@end lisp")
 403 #define FUNC_NAME s_scm_inet_ntop
 404 {
 405   int af;
 406 #ifdef INET6_ADDRSTRLEN
 407   char dst[INET6_ADDRSTRLEN];
 408 #else
 409   char dst[46];
 410 #endif
 411   const char *result;
 412
 413   af = scm_to_int (family);
 414   SCM_ASSERT_RANGE (1, family, af == AF_INET || af == AF_INET6);
 415   if (af == AF_INET)
 416     {
 417       scm_t_uint32 addr4;
 418
 419       addr4 = htonl (SCM_NUM2ULONG (2, address));
 420       result = inet_ntop (af, &addr4, dst, sizeof (dst));
 421     }
 422   else
 423     {
 424       char addr6[16];
 425
 426       scm_to_ipv6 ((scm_t_uint8 *) addr6, address);
 427       result = inet_ntop (af, &addr6, dst, sizeof (dst));
 428     }
 429
 430   if (result == NULL)
 431     SCM_SYSERROR;
 432
 433   return scm_from_locale_string (dst);
 434 }
 435 #undef FUNC_NAME
 436 #endif
 437
 438 #endif  /* HAVE_IPV6 */
 439
 440 SCM_SYMBOL (sym_socket, "socket");
 441
 442 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
 443
 444 SCM_DEFINE (scm_socket, "socket", 3, 0, 0,
 445             (SCM family, SCM style, SCM proto),
 446             "Return a new socket port of the type specified by @var{family},\n"
 447             "@var{style} and @var{proto}.  All three parameters are\n"
 448             "integers.  Supported values for @var{family} are\n"
 449             "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
 450             "Typical values for @var{style} are @code{SOCK_STREAM},\n"
 451             "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
 452             "@var{proto} can be obtained from a protocol name using\n"
 453             "@code{getprotobyname}.  A value of zero specifies the default\n"
 454             "protocol, which is usually right.\n\n"
 455             "A single socket port cannot by used for communication until it\n"
 456             "has been connected to another socket.")
 457 #define FUNC_NAME s_scm_socket
 458 {
 459   int fd;
 460
 461   fd = socket (scm_to_int (family),
 462                scm_to_int (style),
 463                scm_to_int (proto));
 464   if (fd == -1)
 465     SCM_SYSERROR;
 466   return SCM_SOCK_FD_TO_PORT (fd);
 467 }
 468 #undef FUNC_NAME
 469
 470 #ifdef HAVE_SOCKETPAIR
 471 SCM_DEFINE (scm_socketpair, "socketpair", 3, 0, 0,
 472             (SCM family, SCM style, SCM proto),
 473             "Return a pair of connected (but unnamed) socket ports of the\n"
 474             "type specified by @var{family}, @var{style} and @var{proto}.\n"
 475             "Many systems support only socket pairs of the @code{AF_UNIX}\n"
 476             "family.  Zero is likely to be the only meaningful value for\n"
 477             "@var{proto}.")
 478 #define FUNC_NAME s_scm_socketpair
 479 {
 480   int fam;
 481   int fd[2];
 482
 483   fam = scm_to_int (family);
 484
 485   if (socketpair (fam, scm_to_int (style), scm_to_int (proto), fd) == -1)
 486     SCM_SYSERROR;
 487
 488   return scm_cons (SCM_SOCK_FD_TO_PORT (fd[0]), SCM_SOCK_FD_TO_PORT (fd[1]));
 489 }
 490 #undef FUNC_NAME
 491 #endif
 492
 493 /* Possible results for `getsockopt ()'.  Wrapping it into a union guarantees
 494    suitable alignment.  */
 495 typedef union
 496 {
 497 #ifdef HAVE_STRUCT_LINGER
 498   struct linger linger;
 499 #endif
 500   size_t size;
 501   int    integer;
 502 } scm_t_getsockopt_result;
 503
 504 SCM_DEFINE (scm_getsockopt, "getsockopt", 3, 0, 0,
 505             (SCM sock, SCM level, SCM optname),
 506             "Return an option value from socket port @var{sock}.\n"
 507             "\n"
 508             "@var{level} is an integer specifying a protocol layer, either\n"
 509             "@code{SOL_SOCKET} for socket level options, or a protocol\n"
 510             "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
 511             "(@pxref{Network Databases}).\n"
 512             "\n"
 513             "@defvar SOL_SOCKET\n"
 514             "@defvarx IPPROTO_IP\n"
 515             "@defvarx IPPROTO_TCP\n"
 516             "@defvarx IPPROTO_UDP\n"
 517             "@end defvar\n"
 518             "\n"
 519             "@var{optname} is an integer specifying an option within the\n"
 520             "protocol layer.\n"
 521             "\n"
 522             "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
 523             "defined (when provided by the system).  For their meaning see\n"
 524             "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
 525             "Manual}, or @command{man 7 socket}.\n"
 526             "\n"
 527             "@defvar SO_DEBUG\n"
 528             "@defvarx SO_REUSEADDR\n"
 529             "@defvarx SO_STYLE\n"
 530             "@defvarx SO_TYPE\n"
 531             "@defvarx SO_ERROR\n"
 532             "@defvarx SO_DONTROUTE\n"
 533             "@defvarx SO_BROADCAST\n"
 534             "@defvarx SO_SNDBUF\n"
 535             "@defvarx SO_RCVBUF\n"
 536             "@defvarx SO_KEEPALIVE\n"
 537             "@defvarx SO_OOBINLINE\n"
 538             "@defvarx SO_NO_CHECK\n"
 539             "@defvarx SO_PRIORITY\n"
 540             "The value returned is an integer.\n"
 541             "@end defvar\n"
 542             "\n"
 543             "@defvar SO_LINGER\n"
 544             "The @var{value} returned is a pair of integers\n"
 545             "@code{(@var{ENABLE} . @var{TIMEOUT})}.  On old systems without\n"
 546             "timeout support (ie.@: without @code{struct linger}), only\n"
 547             "@var{ENABLE} has an effect but the value in Guile is always a\n"
 548             "pair.\n"
 549             "@end defvar")
 550 #define FUNC_NAME s_scm_getsockopt
 551 {
 552   int fd;
 553   /* size of optval is the largest supported option.  */
 554   scm_t_getsockopt_result optval;
 555   socklen_t optlen = sizeof (optval);
 556   int ilevel;
 557   int ioptname;
 558
 559   sock = SCM_COERCE_OUTPORT (sock);
 560   SCM_VALIDATE_OPFPORT (1, sock);
 561   ilevel = scm_to_int (level);
 562   ioptname = scm_to_int (optname);
 563
 564   fd = SCM_FPORT_FDES (sock);
 565   if (getsockopt (fd, ilevel, ioptname, (void *) &optval, &optlen) == -1)
 566     SCM_SYSERROR;
 567
 568   if (ilevel == SOL_SOCKET)
 569     {
 570 #ifdef SO_LINGER
 571       if (ioptname == SO_LINGER)
 572         {
 573 #ifdef HAVE_STRUCT_LINGER
 574           struct linger *ling = (struct linger *) &optval;
 575
 576           return scm_cons (scm_from_long (ling->l_onoff),
 577                            scm_from_long (ling->l_linger));
 578 #else
 579           return scm_cons (scm_from_long (*(int *) &optval),
 580                            scm_from_int (0));
 581 #endif
 582         }
 583       else
 584 #endif
 585         if (0
 586 #ifdef SO_SNDBUF
 587             || ioptname == SO_SNDBUF
 588 #endif
 589 #ifdef SO_RCVBUF
 590             || ioptname == SO_RCVBUF
 591 #endif
 592             )
 593           {
 594             return scm_from_size_t (*(size_t *) &optval);
 595           }
 596     }
 597   return scm_from_int (*(int *) &optval);
 598 }
 599 #undef FUNC_NAME
 600
 601 SCM_DEFINE (scm_setsockopt, "setsockopt", 4, 0, 0,
 602             (SCM sock, SCM level, SCM optname, SCM value),
 603             "Set an option on socket port @var{sock}.  The return value is\n"
 604             "unspecified.\n"
 605             "\n"
 606             "@var{level} is an integer specifying a protocol layer, either\n"
 607             "@code{SOL_SOCKET} for socket level options, or a protocol\n"
 608             "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
 609             "(@pxref{Network Databases}).\n"
 610             "\n"
 611             "@defvar SOL_SOCKET\n"
 612             "@defvarx IPPROTO_IP\n"
 613             "@defvarx IPPROTO_TCP\n"
 614             "@defvarx IPPROTO_UDP\n"
 615             "@end defvar\n"
 616             "\n"
 617             "@var{optname} is an integer specifying an option within the\n"
 618             "protocol layer.\n"
 619             "\n"
 620             "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
 621             "defined (when provided by the system).  For their meaning see\n"
 622             "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
 623             "Manual}, or @command{man 7 socket}.\n"
 624             "\n"
 625             "@defvar SO_DEBUG\n"
 626             "@defvarx SO_REUSEADDR\n"
 627             "@defvarx SO_STYLE\n"
 628             "@defvarx SO_TYPE\n"
 629             "@defvarx SO_ERROR\n"
 630             "@defvarx SO_DONTROUTE\n"
 631             "@defvarx SO_BROADCAST\n"
 632             "@defvarx SO_SNDBUF\n"
 633             "@defvarx SO_RCVBUF\n"
 634             "@defvarx SO_KEEPALIVE\n"
 635             "@defvarx SO_OOBINLINE\n"
 636             "@defvarx SO_NO_CHECK\n"
 637             "@defvarx SO_PRIORITY\n"
 638             "@var{value} is an integer.\n"
 639             "@end defvar\n"
 640             "\n"
 641             "@defvar SO_LINGER\n"
 642             "@var{value} is a pair of integers @code{(@var{ENABLE}\n"
 643             ". @var{TIMEOUT})}.  On old systems without timeout support\n"
 644             "(ie.@: without @code{struct linger}), only @var{ENABLE} has an\n"
 645             "effect but the value in Guile is always a pair.\n"
 646             "@end defvar\n"
 647             "\n"
 648             "@c  Note that we refer only to ``man ip'' here.  On GNU/Linux it's\n"
 649             "@c  ``man 7 ip'' but on NetBSD it's ``man 4 ip''.\n"
 650             "@c \n"
 651             "For IP level (@code{IPPROTO_IP}) the following @var{optname}s\n"
 652             "are defined (when provided by the system).  See @command{man\n"
 653             "ip} for what they mean.\n"
 654             "\n"
 655             "@defvar IP_ADD_MEMBERSHIP\n"
 656             "@defvarx IP_DROP_MEMBERSHIP\n"
 657             "These can be used only with @code{setsockopt}, not\n"
 658             "@code{getsockopt}.  @var{value} is a pair\n"
 659             "@code{(@var{MULTIADDR} . @var{INTERFACEADDR})} of IPv4\n"
 660             "addresses (@pxref{Network Address Conversion}).\n"
 661             "@var{MULTIADDR} is a multicast address to be added to or\n"
 662             "dropped from the interface @var{INTERFACEADDR}.\n"
 663             "@var{INTERFACEADDR} can be @code{INADDR_ANY} to have the system\n"
 664             "select the interface.  @var{INTERFACEADDR} can also be an\n"
 665             "interface index number, on systems supporting that.\n"
 666             "@end defvar")
 667 #define FUNC_NAME s_scm_setsockopt
 668 {
 669   int fd;
 670
 671   int opt_int;
 672 #ifdef HAVE_STRUCT_LINGER
 673   struct linger opt_linger;
 674 #endif
 675
 676 #if HAVE_STRUCT_IP_MREQ
 677   struct ip_mreq opt_mreq;
 678 #endif
 679
 680   const void *optval = NULL;
 681   socklen_t optlen = 0;
 682
 683   int ilevel, ioptname;
 684
 685   sock = SCM_COERCE_OUTPORT (sock);
 686
 687   SCM_VALIDATE_OPFPORT (1, sock);
 688   ilevel = scm_to_int (level);
 689   ioptname = scm_to_int (optname);
 690
 691   fd = SCM_FPORT_FDES (sock);
 692
 693   if (ilevel == SOL_SOCKET)
 694     {
 695 #ifdef SO_LINGER
 696       if (ioptname == SO_LINGER)
 697         {
 698 #ifdef HAVE_STRUCT_LINGER
 699           SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME);
 700           opt_linger.l_onoff = scm_to_int (SCM_CAR (value));
 701           opt_linger.l_linger = scm_to_int (SCM_CDR (value));
 702           optlen = sizeof (struct linger);
 703           optval = &opt_linger;
 704 #else
 705           SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME);
 706           opt_int = scm_to_int (SCM_CAR (value));
 707           /* timeout is ignored, but may as well validate it.  */
 708           scm_to_int (SCM_CDR (value));
 709           optlen = sizeof (int);
 710           optval = &opt_int;
 711 #endif
 712         }
 713       else
 714 #endif
 715         if (0
 716 #ifdef SO_SNDBUF
 717             || ioptname == SO_SNDBUF
 718 #endif
 719 #ifdef SO_RCVBUF
 720             || ioptname == SO_RCVBUF
 721 #endif
 722             )
 723           {
 724             opt_int = scm_to_int (value);
 725             optlen = sizeof (size_t);
 726             optval = &opt_int;
 727           }
 728     }
 729
 730 #if HAVE_STRUCT_IP_MREQ
 731   if (ilevel == IPPROTO_IP &&
 732       (ioptname == IP_ADD_MEMBERSHIP || ioptname == IP_DROP_MEMBERSHIP))
 733     {
 734       /* Fourth argument must be a pair of addresses. */
 735       SCM_ASSERT (scm_is_pair (value), value, SCM_ARG4, FUNC_NAME);
 736       opt_mreq.imr_multiaddr.s_addr = htonl (scm_to_ulong (SCM_CAR (value)));
 737       opt_mreq.imr_interface.s_addr = htonl (scm_to_ulong (SCM_CDR (value)));
 738       optlen = sizeof (opt_mreq);
 739       optval = &opt_mreq;
 740     }
 741 #endif
 742
 743   if (optval == NULL)
 744     {
 745       /* Most options take an int.  */
 746       opt_int = scm_to_int (value);
 747       optlen = sizeof (int);
 748       optval = &opt_int;
 749     }
 750
 751   if (setsockopt (fd, ilevel, ioptname, optval, optlen) == -1)
 752     SCM_SYSERROR;
 753   return SCM_UNSPECIFIED;
 754 }
 755 #undef FUNC_NAME
 756
 757 SCM_DEFINE (scm_shutdown, "shutdown", 2, 0, 0,
 758           (SCM sock, SCM how),
 759             "Sockets can be closed simply by using @code{close-port}. The\n"
 760             "@code{shutdown} procedure allows reception or transmission on a\n"
 761             "connection to be shut down individually, according to the parameter\n"
 762             "@var{how}:\n\n"
 763             "@table @asis\n"
 764             "@item 0\n"
 765             "Stop receiving data for this socket.  If further data arrives,  reject it.\n"
 766             "@item 1\n"
 767             "Stop trying to transmit data from this socket.  Discard any\n"
 768             "data waiting to be sent.  Stop looking for acknowledgement of\n"
 769             "data already sent; don't retransmit it if it is lost.\n"
 770             "@item 2\n"
 771             "Stop both reception and transmission.\n"
 772             "@end table\n\n"
 773             "The return value is unspecified.")
 774 #define FUNC_NAME s_scm_shutdown
 775 {
 776   int fd;
 777   sock = SCM_COERCE_OUTPORT (sock);
 778   SCM_VALIDATE_OPFPORT (1, sock);
 779   fd = SCM_FPORT_FDES (sock);
 780   if (shutdown (fd, scm_to_signed_integer (how, 0, 2)) == -1)
 781     SCM_SYSERROR;
 782   return SCM_UNSPECIFIED;
 783 }
 784 #undef FUNC_NAME
 785
 786 /* convert fam/address/args into a sockaddr of the appropriate type.
 787    args is modified by removing the arguments actually used.
 788    which_arg and proc are used when reporting errors:
 789    which_arg is the position of address in the original argument list.
 790    proc is the name of the original procedure.
 791    size returns the size of the structure allocated.  */
 792
 793 static struct sockaddr *
 794 scm_fill_sockaddr (int fam, SCM address, SCM *args, int which_arg,
 795                    const char *proc, size_t *size)
 796 #define FUNC_NAME proc
 797 {
 798   switch (fam)
 799     {
 800     case AF_INET:
 801       {
 802         struct sockaddr_in *soka;
 803         unsigned long addr;
 804         int port;
 805
 806         SCM_VALIDATE_ULONG_COPY (which_arg, address, addr);
 807         SCM_VALIDATE_CONS (which_arg + 1, *args);
 808         port = scm_to_int (SCM_CAR (*args));
 809         *args = SCM_CDR (*args);
 810         soka = (struct sockaddr_in *) scm_malloc (sizeof (struct sockaddr_in));
 811
 812 #if HAVE_STRUCT_SOCKADDR_SIN_LEN
 813         soka->sin_len = sizeof (struct sockaddr_in);
 814 #endif
 815         soka->sin_family = AF_INET;
 816         soka->sin_addr.s_addr = htonl (addr);
 817         soka->sin_port = htons (port);
 818         *size = sizeof (struct sockaddr_in);
 819         return (struct sockaddr *) soka;
 820       }
 821 #ifdef HAVE_IPV6
 822     case AF_INET6:
 823       {
 824         /* see RFC2553.  */
 825         int port;
 826         struct sockaddr_in6 *soka;
 827         unsigned long flowinfo = 0;
 828         unsigned long scope_id = 0;
 829
 830         SCM_VALIDATE_CONS (which_arg + 1, *args);
 831         port = scm_to_int (SCM_CAR (*args));
 832         *args = SCM_CDR (*args);
 833         if (scm_is_pair (*args))
 834           {
 835             SCM_VALIDATE_ULONG_COPY (which_arg + 2, SCM_CAR (*args), flowinfo);
 836             *args = SCM_CDR (*args);
 837             if (scm_is_pair (*args))
 838               {
 839                 SCM_VALIDATE_ULONG_COPY (which_arg + 3, SCM_CAR (*args),
 840                                          scope_id);
 841                 *args = SCM_CDR (*args);
 842               }
 843           }
 844         soka = (struct sockaddr_in6 *) scm_malloc (sizeof (struct sockaddr_in6));
 845
 846 #if HAVE_STRUCT_SOCKADDR_IN6_SIN6_LEN
 847         soka->sin6_len = sizeof (struct sockaddr_in6);
 848 #endif
 849         soka->sin6_family = AF_INET6;
 850         scm_to_ipv6 (soka->sin6_addr.s6_addr, address);
 851         soka->sin6_port = htons (port);
 852         soka->sin6_flowinfo = flowinfo;
 853 #ifdef HAVE_SIN6_SCOPE_ID
 854         soka->sin6_scope_id = scope_id;
 855 #endif
 856         *size = sizeof (struct sockaddr_in6);
 857         return (struct sockaddr *) soka;
 858       }
 859 #endif
 860 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
 861     case AF_UNIX:
 862       {
 863         struct sockaddr_un *soka;
 864         int addr_size;
 865         char *c_address;
 866
 867         scm_dynwind_begin (0);
 868
 869         c_address = scm_to_locale_string (address);
 870         scm_dynwind_free (c_address);
 871
 872         /* the static buffer size in sockaddr_un seems to be arbitrary
 873            and not necessarily a hard limit.  e.g., the glibc manual
 874            suggests it may be possible to declare it size 0.  let's
 875            ignore it.  if the O/S doesn't like the size it will cause
 876            connect/bind etc., to fail.  sun_path is always the last
 877            member of the structure.  */
 878         addr_size = sizeof (struct sockaddr_un)
 879           + max (0, strlen (c_address) + 1 - (sizeof soka->sun_path));
 880         soka = (struct sockaddr_un *) scm_malloc (addr_size);
 881         memset (soka, 0, addr_size);  /* for sun_len: see sin_len above. */
 882         soka->sun_family = AF_UNIX;
 883         strcpy (soka->sun_path, c_address);
 884         *size = SUN_LEN (soka);
 885
 886         scm_dynwind_end ();
 887         return (struct sockaddr *) soka;
 888       }
 889 #endif
 890     default:
 891       scm_out_of_range (proc, scm_from_int (fam));
 892     }
 893 }
 894 #undef FUNC_NAME
 895
 896 SCM_DEFINE (scm_connect, "connect", 2, 1, 1,
 897             (SCM sock, SCM fam_or_sockaddr, SCM address, SCM args),
 898             "Initiate a connection from a socket using a specified address\n"
 899             "family to the address\n"
 900             "specified by @var{address} and possibly @var{args}.\n"
 901             "The format required for @var{address}\n"
 902             "and @var{args} depends on the family of the socket.\n\n"
 903             "For a socket of family @code{AF_UNIX},\n"
 904             "only @var{address} is specified and must be a string with the\n"
 905             "filename where the socket is to be created.\n\n"
 906             "For a socket of family @code{AF_INET},\n"
 907             "@var{address} must be an integer IPv4 host address and\n"
 908             "@var{args} must be a single integer port number.\n\n"
 909             "For a socket of family @code{AF_INET6},\n"
 910             "@var{address} must be an integer IPv6 host address and\n"
 911             "@var{args} may be up to three integers:\n"
 912             "port [flowinfo] [scope_id],\n"
 913             "where flowinfo and scope_id default to zero.\n\n"
 914             "Alternatively, the second argument can be a socket address object "
 915             "as returned by @code{make-socket-address}, in which case the "
 916             "no additional arguments should be passed.\n\n"
 917             "The return value is unspecified.")
 918 #define FUNC_NAME s_scm_connect
 919 {
 920   int fd;
 921   struct sockaddr *soka;
 922   size_t size;
 923
 924   sock = SCM_COERCE_OUTPORT (sock);
 925   SCM_VALIDATE_OPFPORT (1, sock);
 926   fd = SCM_FPORT_FDES (sock);
 927
 928   if (address == SCM_UNDEFINED)
 929     /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
 930        `socket address' object.  */
 931     soka = scm_to_sockaddr (fam_or_sockaddr, &size);
 932   else
 933     soka = scm_fill_sockaddr (scm_to_int (fam_or_sockaddr), address,
 934                               &args, 3, FUNC_NAME, &size);
 935
 936   if (connect (fd, soka, size) == -1)
 937     {
 938       int save_errno = errno;
 939
 940       free (soka);
 941       errno = save_errno;
 942       SCM_SYSERROR;
 943     }
 944   free (soka);
 945   return SCM_UNSPECIFIED;
 946 }
 947 #undef FUNC_NAME
 948
 949 SCM_DEFINE (scm_bind, "bind", 2, 1, 1,
 950             (SCM sock, SCM fam_or_sockaddr, SCM address, SCM args),
 951             "Assign an address to the socket port @var{sock}.\n"
 952             "Generally this only needs to be done for server sockets,\n"
 953             "so they know where to look for incoming connections.  A socket\n"
 954             "without an address will be assigned one automatically when it\n"
 955             "starts communicating.\n\n"
 956             "The format of @var{address} and @var{args} depends\n"
 957             "on the family of the socket.\n\n"
 958             "For a socket of family @code{AF_UNIX}, only @var{address}\n"
 959             "is specified and must be a string with the filename where\n"
 960             "the socket is to be created.\n\n"
 961             "For a socket of family @code{AF_INET}, @var{address}\n"
 962             "must be an integer IPv4 address and @var{args}\n"
 963             "must be a single integer port number.\n\n"
 964             "The values of the following variables can also be used for\n"
 965             "@var{address}:\n\n"
 966             "@defvar INADDR_ANY\n"
 967             "Allow connections from any address.\n"
 968             "@end defvar\n\n"
 969             "@defvar INADDR_LOOPBACK\n"
 970             "The address of the local host using the loopback device.\n"
 971             "@end defvar\n\n"
 972             "@defvar INADDR_BROADCAST\n"
 973             "The broadcast address on the local network.\n"
 974             "@end defvar\n\n"
 975             "@defvar INADDR_NONE\n"
 976             "No address.\n"
 977             "@end defvar\n\n"
 978             "For a socket of family @code{AF_INET6}, @var{address}\n"
 979             "must be an integer IPv6 address and @var{args}\n"
 980             "may be up to three integers:\n"
 981             "port [flowinfo] [scope_id],\n"
 982             "where flowinfo and scope_id default to zero.\n\n"
 983             "Alternatively, the second argument can be a socket address object "
 984             "as returned by @code{make-socket-address}, in which case the "
 985             "no additional arguments should be passed.\n\n"
 986             "The return value is unspecified.")
 987 #define FUNC_NAME s_scm_bind
 988 {
 989   struct sockaddr *soka;
 990   size_t size;
 991   int fd;
 992
 993   sock = SCM_COERCE_OUTPORT (sock);
 994   SCM_VALIDATE_OPFPORT (1, sock);
 995   fd = SCM_FPORT_FDES (sock);
 996
 997   if (address == SCM_UNDEFINED)
 998     /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
 999        `socket address' object.  */
1000     soka = scm_to_sockaddr (fam_or_sockaddr, &size);
1001   else
1002     soka = scm_fill_sockaddr (scm_to_int (fam_or_sockaddr), address,
1003                               &args, 3, FUNC_NAME, &size);
1004
1005
1006   if (bind (fd, soka, size) == -1)
1007   {
1008     int save_errno = errno;
1009
1010     free (soka);
1011     errno = save_errno;
1012     SCM_SYSERROR;
1013   }
1014   free (soka);
1015   return SCM_UNSPECIFIED;
1016 }
1017 #undef FUNC_NAME
1018
1019 SCM_DEFINE (scm_listen, "listen", 2, 0, 0,
1020             (SCM sock, SCM backlog),
1021             "Enable @var{sock} to accept connection\n"
1022             "requests.  @var{backlog} is an integer specifying\n"
1023             "the maximum length of the queue for pending connections.\n"
1024             "If the queue fills, new clients will fail to connect until\n"
1025             "the server calls @code{accept} to accept a connection from\n"
1026             "the queue.\n\n"
1027             "The return value is unspecified.")
1028 #define FUNC_NAME s_scm_listen
1029 {
1030   int fd;
1031   sock = SCM_COERCE_OUTPORT (sock);
1032   SCM_VALIDATE_OPFPORT (1, sock);
1033   fd = SCM_FPORT_FDES (sock);
1034   if (listen (fd, scm_to_int (backlog)) == -1)
1035     SCM_SYSERROR;
1036   return SCM_UNSPECIFIED;
1037 }
1038 #undef FUNC_NAME
1039
1040 /* Put the components of a sockaddr into a new SCM vector.  */
1041 static SCM_C_INLINE_KEYWORD SCM
1042 _scm_from_sockaddr (const scm_t_max_sockaddr *address, unsigned addr_size,
1043                     const char *proc)
1044 {
1045   SCM result = SCM_EOL;
1046   short int fam = ((struct sockaddr *) address)->sa_family;
1047
1048   switch (fam)
1049     {
1050     case AF_INET:
1051       {
1052         const struct sockaddr_in *nad = (struct sockaddr_in *) address;
1053
1054         result = scm_c_make_vector (3, SCM_UNSPECIFIED);
1055
1056         SCM_SIMPLE_VECTOR_SET(result, 0,
1057                               scm_from_short (fam));
1058         SCM_SIMPLE_VECTOR_SET(result, 1,
1059                               scm_from_ulong (ntohl (nad->sin_addr.s_addr)));
1060         SCM_SIMPLE_VECTOR_SET(result, 2,
1061                               scm_from_ushort (ntohs (nad->sin_port)));
1062       }
1063       break;
1064 #ifdef HAVE_IPV6
1065     case AF_INET6:
1066       {
1067         const struct sockaddr_in6 *nad = (struct sockaddr_in6 *) address;
1068
1069         result = scm_c_make_vector (5, SCM_UNSPECIFIED);
1070         SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_short (fam));
1071         SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_ipv6 (nad->sin6_addr.s6_addr));
1072         SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_ushort (ntohs (nad->sin6_port)));
1073         SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_uint32 (nad->sin6_flowinfo));
1074 #ifdef HAVE_SIN6_SCOPE_ID
1075         SCM_SIMPLE_VECTOR_SET(result, 4, scm_from_ulong (nad->sin6_scope_id));
1076 #else
1077         SCM_SIMPLE_VECTOR_SET(result, 4, SCM_INUM0);
1078 #endif
1079       }
1080       break;
1081 #endif
1082 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1083     case AF_UNIX:
1084       {
1085         const struct sockaddr_un *nad = (struct sockaddr_un *) address;
1086
1087         result = scm_c_make_vector (2, SCM_UNSPECIFIED);
1088
1089         SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_short (fam));
1090         /* When addr_size is not enough to cover sun_path, do not try
1091            to access it. */
1092         if (addr_size <= offsetof (struct sockaddr_un, sun_path))
1093           SCM_SIMPLE_VECTOR_SET(result, 1, SCM_BOOL_F);
1094         else
1095           SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_locale_string (nad->sun_path));
1096       }
1097       break;
1098 #endif
1099     default:
1100       result = SCM_UNSPECIFIED;
1101       scm_misc_error (proc, "unrecognised address family: ~A",
1102                       scm_list_1 (scm_from_int (fam)));
1103
1104     }
1105   return result;
1106 }
1107
1108 /* The publicly-visible function.  Return a Scheme object representing
1109    ADDRESS, an address of ADDR_SIZE bytes.  */
1110 SCM
1111 scm_from_sockaddr (const struct sockaddr *address, unsigned addr_size)
1112 {
1113   return (_scm_from_sockaddr ((scm_t_max_sockaddr *) address,
1114                               addr_size, "scm_from_sockaddr"));
1115 }
1116
1117 /* Convert ADDRESS, an address object returned by either
1118    `scm_from_sockaddr ()' or `scm_make_socket_address ()', into its C
1119    representation.  On success, a non-NULL pointer is returned and
1120    ADDRESS_SIZE is updated to the actual size (in bytes) of the returned
1121    address.  The result must eventually be freed using `free ()'.  */
1122 struct sockaddr *
1123 scm_to_sockaddr (SCM address, size_t *address_size)
1124 #define FUNC_NAME "scm_to_sockaddr"
1125 {
1126   short int family;
1127   struct sockaddr *c_address = NULL;
1128
1129   SCM_VALIDATE_VECTOR (1, address);
1130
1131   *address_size = 0;
1132   family = scm_to_short (SCM_SIMPLE_VECTOR_REF (address, 0));
1133
1134   switch (family)
1135     {
1136     case AF_INET:
1137       {
1138         if (SCM_SIMPLE_VECTOR_LENGTH (address) != 3)
1139           scm_misc_error (FUNC_NAME,
1140                           "invalid inet address representation: ~A",
1141                           scm_list_1 (address));
1142         else
1143           {
1144             struct sockaddr_in c_inet;
1145
1146             c_inet.sin_addr.s_addr =
1147               htonl (scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address, 1)));
1148             c_inet.sin_port =
1149               htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address, 2)));
1150             c_inet.sin_family = AF_INET;
1151
1152             *address_size = sizeof (c_inet);
1153             c_address = scm_malloc (sizeof (c_inet));
1154             memcpy (c_address, &c_inet, sizeof (c_inet));
1155           }
1156
1157         break;
1158       }
1159
1160 #ifdef HAVE_IPV6
1161     case AF_INET6:
1162       {
1163         if (SCM_SIMPLE_VECTOR_LENGTH (address) != 5)
1164           scm_misc_error (FUNC_NAME, "invalid inet6 address representation: ~A",
1165                           scm_list_1 (address));
1166         else
1167           {
1168             struct sockaddr_in6 c_inet6;
1169
1170             scm_to_ipv6 (c_inet6.sin6_addr.s6_addr,
1171                          SCM_SIMPLE_VECTOR_REF (address, 1));
1172             c_inet6.sin6_port =
1173               htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address, 2)));
1174             c_inet6.sin6_flowinfo =
1175               scm_to_uint32 (SCM_SIMPLE_VECTOR_REF (address, 3));
1176 #ifdef HAVE_SIN6_SCOPE_ID
1177             c_inet6.sin6_scope_id =
1178               scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address, 4));
1179 #endif
1180
1181             c_inet6.sin6_family = AF_INET6;
1182
1183             *address_size = sizeof (c_inet6);
1184             c_address = scm_malloc (sizeof (c_inet6));
1185             memcpy (c_address, &c_inet6, sizeof (c_inet6));
1186           }
1187
1188         break;
1189       }
1190 #endif
1191
1192 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1193     case AF_UNIX:
1194       {
1195         if (SCM_SIMPLE_VECTOR_LENGTH (address) != 2)
1196           scm_misc_error (FUNC_NAME, "invalid unix address representation: ~A",
1197                           scm_list_1 (address));
1198         else
1199           {
1200             SCM path;
1201             size_t path_len = 0;
1202
1203             path = SCM_SIMPLE_VECTOR_REF (address, 1);
1204             if ((!scm_is_string (path)) && (path != SCM_BOOL_F))
1205               scm_misc_error (FUNC_NAME, "invalid unix address "
1206                               "path: ~A", scm_list_1 (path));
1207             else
1208               {
1209                 struct sockaddr_un c_unix;
1210
1211                 if (path == SCM_BOOL_F)
1212                   path_len = 0;
1213                 else
1214                   path_len = scm_c_string_length (path);
1215
1216 #ifdef UNIX_PATH_MAX
1217                 if (path_len >= UNIX_PATH_MAX)
1218 #else
1219 /* We can hope that this limit will eventually vanish, at least on GNU.
1220    However, currently, while glibc doesn't define `UNIX_PATH_MAX', it
1221    documents it has being limited to 108 bytes.  */
1222                 if (path_len >= sizeof (c_unix.sun_path))
1223 #endif
1224                   scm_misc_error (FUNC_NAME, "unix address path "
1225                                   "too long: ~A", scm_list_1 (path));
1226                 else
1227                   {
1228                     if (path_len)
1229                       {
1230                         scm_to_locale_stringbuf (path, c_unix.sun_path,
1231 #ifdef UNIX_PATH_MAX
1232                                                  UNIX_PATH_MAX);
1233 #else
1234                                                  sizeof (c_unix.sun_path));
1235 #endif
1236                         c_unix.sun_path[path_len] = '\0';
1237
1238                         /* Sanity check.  */
1239                         if (strlen (c_unix.sun_path) != path_len)
1240                           scm_misc_error (FUNC_NAME, "unix address path "
1241                                           "contains nul characters: ~A",
1242                                           scm_list_1 (path));
1243                       }
1244                     else
1245                       c_unix.sun_path[0] = '\0';
1246
1247                     c_unix.sun_family = AF_UNIX;
1248
1249                     *address_size = SUN_LEN (&c_unix);
1250                     c_address = scm_malloc (sizeof (c_unix));
1251                     memcpy (c_address, &c_unix, sizeof (c_unix));
1252                   }
1253               }
1254           }
1255
1256         break;
1257       }
1258 #endif
1259
1260     default:
1261       scm_misc_error (FUNC_NAME, "unrecognised address family: ~A",
1262                       scm_list_1 (scm_from_ushort (family)));
1263     }
1264
1265   return c_address;
1266 }
1267 #undef FUNC_NAME
1268
1269
1270 /* Return a newly-allocated `sockaddr' structure that reflects ADDRESS, being
1271    an address of family FAMILY, with the family-specific parameters ARGS (see
1272    the description of `connect' for details).  The returned structure may be
1273    freed using `free ()'.  */
1274 struct sockaddr *
1275 scm_c_make_socket_address (SCM family, SCM address, SCM args,
1276                            size_t *address_size)
1277 {
1278   struct sockaddr *soka;
1279
1280   soka = scm_fill_sockaddr (scm_to_ushort (family), address, &args, 1,
1281                             "scm_c_make_socket_address", address_size);
1282
1283   return soka;
1284 }
1285
1286 SCM_DEFINE (scm_make_socket_address, "make-socket-address", 2, 0, 1,
1287             (SCM family, SCM address, SCM args),
1288             "Return a Scheme address object that reflects @var{address}, "
1289             "being an address of family @var{family}, with the "
1290             "family-specific parameters @var{args} (see the description of "
1291             "@code{connect} for details).")
1292 #define FUNC_NAME s_scm_make_socket_address
1293 {
1294   SCM result = SCM_BOOL_F;
1295   struct sockaddr *c_address;
1296   size_t c_address_size;
1297
1298   c_address = scm_c_make_socket_address (family, address, args,
1299                                          &c_address_size);
1300   if (c_address != NULL)
1301     {
1302       result = scm_from_sockaddr (c_address, c_address_size);
1303       free (c_address);
1304     }
1305
1306   return result;
1307 }
1308 #undef FUNC_NAME
1309
1310 \f
1311 SCM_DEFINE (scm_accept, "accept", 1, 0, 0,
1312             (SCM sock),
1313             "Accept a connection on a bound, listening socket.\n"
1314             "If there\n"
1315             "are no pending connections in the queue, wait until\n"
1316             "one is available unless the non-blocking option has been\n"
1317             "set on the socket.\n\n"
1318             "The return value is a\n"
1319             "pair in which the @emph{car} is a new socket port for the\n"
1320             "connection and\n"
1321             "the @emph{cdr} is an object with address information about the\n"
1322             "client which initiated the connection.\n\n"
1323             "@var{sock} does not become part of the\n"
1324             "connection and will continue to accept new requests.")
1325 #define FUNC_NAME s_scm_accept
1326 {
1327   int fd, selected;
1328   int newfd;
1329   SCM address;
1330   SCM newsock;
1331   SELECT_TYPE readfds, exceptfds;
1332   socklen_t addr_size = MAX_ADDR_SIZE;
1333   scm_t_max_sockaddr addr;
1334
1335   sock = SCM_COERCE_OUTPORT (sock);
1336   SCM_VALIDATE_OPFPORT (1, sock);
1337   fd = SCM_FPORT_FDES (sock);
1338
1339   FD_ZERO (&readfds);
1340   FD_ZERO (&exceptfds);
1341   FD_SET (fd, &readfds);
1342   FD_SET (fd, &exceptfds);
1343
1344   /* Block until something happens on FD, leaving guile mode while
1345      waiting.  */
1346   selected = scm_std_select (fd + 1, &readfds, NULL, &exceptfds,
1347                              NULL);
1348   if (selected < 0)
1349     SCM_SYSERROR;
1350
1351   newfd = accept (fd, (struct sockaddr *) &addr, &addr_size);
1352   if (newfd == -1)
1353     SCM_SYSERROR;
1354   newsock = SCM_SOCK_FD_TO_PORT (newfd);
1355   address = _scm_from_sockaddr (&addr, addr_size,
1356                                 FUNC_NAME);
1357
1358   return scm_cons (newsock, address);
1359 }
1360 #undef FUNC_NAME
1361
1362 SCM_DEFINE (scm_getsockname, "getsockname", 1, 0, 0,
1363             (SCM sock),
1364             "Return the address of @var{sock}, in the same form as the\n"
1365             "object returned by @code{accept}.  On many systems the address\n"
1366             "of a socket in the @code{AF_FILE} namespace cannot be read.")
1367 #define FUNC_NAME s_scm_getsockname
1368 {
1369   int fd;
1370   socklen_t addr_size = MAX_ADDR_SIZE;
1371   scm_t_max_sockaddr addr;
1372
1373   sock = SCM_COERCE_OUTPORT (sock);
1374   SCM_VALIDATE_OPFPORT (1, sock);
1375   fd = SCM_FPORT_FDES (sock);
1376   if (getsockname (fd, (struct sockaddr *) &addr, &addr_size) == -1)
1377     SCM_SYSERROR;
1378
1379   return _scm_from_sockaddr (&addr, addr_size, FUNC_NAME);
1380 }
1381 #undef FUNC_NAME
1382
1383 SCM_DEFINE (scm_getpeername, "getpeername", 1, 0, 0,
1384             (SCM sock),
1385             "Return the address that @var{sock}\n"
1386             "is connected to, in the same form as the object returned by\n"
1387             "@code{accept}.  On many systems the address of a socket in the\n"
1388             "@code{AF_FILE} namespace cannot be read.")
1389 #define FUNC_NAME s_scm_getpeername
1390 {
1391   int fd;
1392   socklen_t addr_size = MAX_ADDR_SIZE;
1393   scm_t_max_sockaddr addr;
1394
1395   sock = SCM_COERCE_OUTPORT (sock);
1396   SCM_VALIDATE_OPFPORT (1, sock);
1397   fd = SCM_FPORT_FDES (sock);
1398   if (getpeername (fd, (struct sockaddr *) &addr, &addr_size) == -1)
1399     SCM_SYSERROR;
1400
1401   return _scm_from_sockaddr (&addr, addr_size, FUNC_NAME);
1402 }
1403 #undef FUNC_NAME
1404
1405 SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
1406             (SCM sock, SCM buf, SCM flags),
1407             "Receive data from a socket port.\n"
1408             "@var{sock} must already\n"
1409             "be bound to the address from which data is to be received.\n"
1410             "@var{buf} is a string into which\n"
1411             "the data will be written.  The size of @var{buf} limits\n"
1412             "the amount of\n"
1413             "data which can be received: in the case of packet\n"
1414             "protocols, if a packet larger than this limit is encountered\n"
1415             "then some data\n"
1416             "will be irrevocably lost.\n\n"
1417             "The optional @var{flags} argument is a value or\n"
1418             "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1419             "The value returned is the number of bytes read from the\n"
1420             "socket.\n\n"
1421             "Note that the data is read directly from the socket file\n"
1422             "descriptor:\n"
1423             "any unread buffered port data is ignored.")
1424 #define FUNC_NAME s_scm_recv
1425 {
1426   int rv;
1427   int fd;
1428   int flg;
1429   char *dest;
1430   size_t len;
1431
1432   SCM_VALIDATE_OPFPORT (1, sock);
1433   SCM_VALIDATE_STRING (2, buf);
1434   if (SCM_UNBNDP (flags))
1435     flg = 0;
1436   else
1437     flg = scm_to_int (flags);
1438   fd = SCM_FPORT_FDES (sock);
1439
1440   len =  scm_i_string_length (buf);
1441   dest = scm_i_string_writable_chars (buf);
1442   SCM_SYSCALL (rv = recv (fd, dest, len, flg));
1443   scm_i_string_stop_writing ();
1444
1445   if (rv == -1)
1446     SCM_SYSERROR;
1447
1448   scm_remember_upto_here_1 (buf);
1449   return scm_from_int (rv);
1450 }
1451 #undef FUNC_NAME
1452
1453 SCM_DEFINE (scm_send, "send", 2, 1, 0,
1454             (SCM sock, SCM message, SCM flags),
1455             "Transmit the string @var{message} on a socket port @var{sock}.\n"
1456             "@var{sock} must already be bound to a destination address.  The\n"
1457             "value returned is the number of bytes transmitted --\n"
1458             "it's possible for\n"
1459             "this to be less than the length of @var{message}\n"
1460             "if the socket is\n"
1461             "set to be non-blocking.  The optional @var{flags} argument\n"
1462             "is a value or\n"
1463             "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1464             "Note that the data is written directly to the socket\n"
1465             "file descriptor:\n"
1466             "any unflushed buffered port data is ignored.")
1467 #define FUNC_NAME s_scm_send
1468 {
1469   int rv;
1470   int fd;
1471   int flg;
1472   const char *src;
1473   size_t len;
1474
1475   sock = SCM_COERCE_OUTPORT (sock);
1476   SCM_VALIDATE_OPFPORT (1, sock);
1477   SCM_VALIDATE_STRING (2, message);
1478   if (SCM_UNBNDP (flags))
1479     flg = 0;
1480   else
1481     flg = scm_to_int (flags);
1482   fd = SCM_FPORT_FDES (sock);
1483
1484   len = scm_i_string_length (message);
1485   src = scm_i_string_writable_chars (message);
1486   SCM_SYSCALL (rv = send (fd, src, len, flg));
1487   scm_i_string_stop_writing ();
1488
1489   if (rv == -1)
1490     SCM_SYSERROR;
1491
1492   scm_remember_upto_here_1 (message);
1493   return scm_from_int (rv);
1494 }
1495 #undef FUNC_NAME
1496
1497 SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0,
1498             (SCM sock, SCM str, SCM flags, SCM start, SCM end),
1499             "Receive data from socket port @var{sock} (which must be already\n"
1500             "bound), returning the originating address as well as the data.\n"
1501             "This is usually for use on datagram sockets, but can be used on\n"
1502             "stream-oriented sockets too.\n"
1503             "\n"
1504             "The data received is stored in the given @var{str}, using\n"
1505             "either the whole string or just the region between the optional\n"
1506             "@var{start} and @var{end} positions.  The size of @var{str}\n"
1507             "limits the amount of data which can be received.  For datagram\n"
1508             "protocols, if a packet larger than this is received then excess\n"
1509             "bytes are irrevocably lost.\n"
1510             "\n"
1511             "The return value is a pair.  The @code{car} is the number of\n"
1512             "bytes read.  The @code{cdr} is a socket address object which is\n"
1513             "where the data come from, or @code{#f} if the origin is\n"
1514             "unknown.\n"
1515             "\n"
1516             "The optional @var{flags} argument is a or bitwise OR\n"
1517             "(@code{logior}) of @code{MSG_OOB}, @code{MSG_PEEK},\n"
1518             "@code{MSG_DONTROUTE} etc.\n"
1519             "\n"
1520             "Data is read directly from the socket file descriptor, any\n"
1521             "buffered port data is ignored.\n"
1522             "\n"
1523             "On a GNU/Linux system @code{recvfrom!} is not multi-threading,\n"
1524             "all threads stop while a @code{recvfrom!} call is in progress.\n"
1525             "An application may need to use @code{select}, @code{O_NONBLOCK}\n"
1526             "or @code{MSG_DONTWAIT} to avoid this.")
1527 #define FUNC_NAME s_scm_recvfrom
1528 {
1529   int rv;
1530   int fd;
1531   int flg;
1532   char *buf;
1533   size_t offset;
1534   size_t cend;
1535   SCM address;
1536   socklen_t addr_size = MAX_ADDR_SIZE;
1537   scm_t_max_sockaddr addr;
1538
1539   SCM_VALIDATE_OPFPORT (1, sock);
1540   fd = SCM_FPORT_FDES (sock);
1541
1542   SCM_VALIDATE_STRING (2, str);
1543   scm_i_get_substring_spec (scm_i_string_length (str),
1544                             start, &offset, end, &cend);
1545
1546   if (SCM_UNBNDP (flags))
1547     flg = 0;
1548   else
1549     SCM_VALIDATE_ULONG_COPY (3, flags, flg);
1550
1551   /* recvfrom will not necessarily return an address.  usually nothing
1552      is returned for stream sockets.  */
1553   buf = scm_i_string_writable_chars (str);
1554   ((struct sockaddr *) &addr)->sa_family = AF_UNSPEC;
1555   SCM_SYSCALL (rv = recvfrom (fd, buf + offset,
1556                               cend - offset, flg,
1557                               (struct sockaddr *) &addr, &addr_size));
1558   scm_i_string_stop_writing ();
1559
1560   if (rv == -1)
1561     SCM_SYSERROR;
1562   if (((struct sockaddr *) &addr)->sa_family != AF_UNSPEC)
1563     address = _scm_from_sockaddr (&addr, addr_size, FUNC_NAME);
1564   else
1565     address = SCM_BOOL_F;
1566
1567   scm_remember_upto_here_1 (str);
1568
1569   return scm_cons (scm_from_int (rv), address);
1570 }
1571 #undef FUNC_NAME
1572
1573 SCM_DEFINE (scm_sendto, "sendto", 3, 1, 1,
1574             (SCM sock, SCM message, SCM fam_or_sockaddr, SCM address, SCM args_and_flags),
1575             "Transmit the string @var{message} on the socket port\n"
1576             "@var{sock}.  The\n"
1577             "destination address is specified using the @var{fam},\n"
1578             "@var{address} and\n"
1579             "@var{args_and_flags} arguments, or just a socket address object "
1580             "returned by @code{make-socket-address}, in a similar way to the\n"
1581             "@code{connect} procedure.  @var{args_and_flags} contains\n"
1582             "the usual connection arguments optionally followed by\n"
1583             "a flags argument, which is a value or\n"
1584             "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1585             "The value returned is the number of bytes transmitted --\n"
1586             "it's possible for\n"
1587             "this to be less than the length of @var{message} if the\n"
1588             "socket is\n"
1589             "set to be non-blocking.\n"
1590             "Note that the data is written directly to the socket\n"
1591             "file descriptor:\n"
1592             "any unflushed buffered port data is ignored.")
1593 #define FUNC_NAME s_scm_sendto
1594 {
1595   int rv;
1596   int fd;
1597   int flg;
1598   struct sockaddr *soka;
1599   size_t size;
1600
1601   sock = SCM_COERCE_OUTPORT (sock);
1602   SCM_VALIDATE_FPORT (1, sock);
1603   SCM_VALIDATE_STRING (2, message);
1604   fd = SCM_FPORT_FDES (sock);
1605
1606   if (!scm_is_number (fam_or_sockaddr))
1607     {
1608       /* FAM_OR_SOCKADDR must actually be a `socket address' object.  This
1609          means that the following arguments, i.e. ADDRESS and those listed in
1610          ARGS_AND_FLAGS, are the `MSG_' flags.  */
1611       soka = scm_to_sockaddr (fam_or_sockaddr, &size);
1612       if (address != SCM_UNDEFINED)
1613         args_and_flags = scm_cons (address, args_and_flags);
1614     }
1615   else
1616     soka = scm_fill_sockaddr (scm_to_int (fam_or_sockaddr), address,
1617                               &args_and_flags, 3, FUNC_NAME, &size);
1618
1619   if (scm_is_null (args_and_flags))
1620     flg = 0;
1621   else
1622     {
1623       SCM_VALIDATE_CONS (5, args_and_flags);
1624       flg = SCM_NUM2ULONG (5, SCM_CAR (args_and_flags));
1625     }
1626   SCM_SYSCALL (rv = sendto (fd,
1627                             scm_i_string_chars (message),
1628                             scm_i_string_length (message),
1629                             flg, soka, size));
1630   if (rv == -1)
1631     {
1632       int save_errno = errno;
1633       free (soka);
1634       errno = save_errno;
1635       SCM_SYSERROR;
1636     }
1637   free (soka);
1638
1639   scm_remember_upto_here_1 (message);
1640   return scm_from_int (rv);
1641 }
1642 #undef FUNC_NAME
1643 \f
1644
1645
1646 void
1647 scm_init_socket ()
1648 {
1649   /* protocol families.  */
1650 #ifdef AF_UNSPEC
1651   scm_c_define ("AF_UNSPEC", scm_from_int (AF_UNSPEC));
1652 #endif
1653 #ifdef AF_UNIX
1654   scm_c_define ("AF_UNIX", scm_from_int (AF_UNIX));
1655 #endif
1656 #ifdef AF_INET
1657   scm_c_define ("AF_INET", scm_from_int (AF_INET));
1658 #endif
1659 #ifdef AF_INET6
1660   scm_c_define ("AF_INET6", scm_from_int (AF_INET6));
1661 #endif
1662
1663 #ifdef PF_UNSPEC
1664   scm_c_define ("PF_UNSPEC", scm_from_int (PF_UNSPEC));
1665 #endif
1666 #ifdef PF_UNIX
1667   scm_c_define ("PF_UNIX", scm_from_int (PF_UNIX));
1668 #endif
1669 #ifdef PF_INET
1670   scm_c_define ("PF_INET", scm_from_int (PF_INET));
1671 #endif
1672 #ifdef PF_INET6
1673   scm_c_define ("PF_INET6", scm_from_int (PF_INET6));
1674 #endif
1675
1676   /* standard addresses.  */
1677 #ifdef INADDR_ANY
1678   scm_c_define ("INADDR_ANY", scm_from_ulong (INADDR_ANY));
1679 #endif
1680 #ifdef INADDR_BROADCAST
1681   scm_c_define ("INADDR_BROADCAST", scm_from_ulong (INADDR_BROADCAST));
1682 #endif
1683 #ifdef INADDR_NONE
1684   scm_c_define ("INADDR_NONE", scm_from_ulong (INADDR_NONE));
1685 #endif
1686 #ifdef INADDR_LOOPBACK
1687   scm_c_define ("INADDR_LOOPBACK", scm_from_ulong (INADDR_LOOPBACK));
1688 #endif
1689
1690   /* socket types.
1691
1692      SOCK_PACKET is deliberately omitted, the GNU/Linux socket(2) and
1693      packet(7) advise that it's obsolete and strongly deprecated.  */
1694
1695 #ifdef SOCK_STREAM
1696   scm_c_define ("SOCK_STREAM", scm_from_int (SOCK_STREAM));
1697 #endif
1698 #ifdef SOCK_DGRAM
1699   scm_c_define ("SOCK_DGRAM", scm_from_int (SOCK_DGRAM));
1700 #endif
1701 #ifdef SOCK_SEQPACKET
1702   scm_c_define ("SOCK_SEQPACKET", scm_from_int (SOCK_SEQPACKET));
1703 #endif
1704 #ifdef SOCK_RAW
1705   scm_c_define ("SOCK_RAW", scm_from_int (SOCK_RAW));
1706 #endif
1707 #ifdef SOCK_RDM
1708   scm_c_define ("SOCK_RDM", scm_from_int (SOCK_RDM));
1709 #endif
1710
1711   /* setsockopt level.
1712
1713      SOL_IP, SOL_TCP and SOL_UDP are defined on gnu/linux, but not on for
1714      instance NetBSD.  We define IPPROTOs because that's what the posix spec
1715      shows in its example at
1716
1717      http://www.opengroup.org/onlinepubs/007904975/functions/getsockopt.html
1718   */
1719 #ifdef SOL_SOCKET
1720   scm_c_define ("SOL_SOCKET", scm_from_int (SOL_SOCKET));
1721 #endif
1722 #ifdef IPPROTO_IP
1723   scm_c_define ("IPPROTO_IP", scm_from_int (IPPROTO_IP));
1724 #endif
1725 #ifdef IPPROTO_TCP
1726   scm_c_define ("IPPROTO_TCP", scm_from_int (IPPROTO_TCP));
1727 #endif
1728 #ifdef IPPROTO_UDP
1729   scm_c_define ("IPPROTO_UDP", scm_from_int (IPPROTO_UDP));
1730 #endif
1731
1732   /* setsockopt names.  */
1733 #ifdef SO_DEBUG
1734   scm_c_define ("SO_DEBUG", scm_from_int (SO_DEBUG));
1735 #endif
1736 #ifdef SO_REUSEADDR
1737   scm_c_define ("SO_REUSEADDR", scm_from_int (SO_REUSEADDR));
1738 #endif
1739 #ifdef SO_STYLE
1740   scm_c_define ("SO_STYLE", scm_from_int (SO_STYLE));
1741 #endif
1742 #ifdef SO_TYPE
1743   scm_c_define ("SO_TYPE", scm_from_int (SO_TYPE));
1744 #endif
1745 #ifdef SO_ERROR
1746   scm_c_define ("SO_ERROR", scm_from_int (SO_ERROR));
1747 #endif
1748 #ifdef SO_DONTROUTE
1749   scm_c_define ("SO_DONTROUTE", scm_from_int (SO_DONTROUTE));
1750 #endif
1751 #ifdef SO_BROADCAST
1752   scm_c_define ("SO_BROADCAST", scm_from_int (SO_BROADCAST));
1753 #endif
1754 #ifdef SO_SNDBUF
1755   scm_c_define ("SO_SNDBUF", scm_from_int (SO_SNDBUF));
1756 #endif
1757 #ifdef SO_RCVBUF
1758   scm_c_define ("SO_RCVBUF", scm_from_int (SO_RCVBUF));
1759 #endif
1760 #ifdef SO_KEEPALIVE
1761   scm_c_define ("SO_KEEPALIVE", scm_from_int (SO_KEEPALIVE));
1762 #endif
1763 #ifdef SO_OOBINLINE
1764   scm_c_define ("SO_OOBINLINE", scm_from_int (SO_OOBINLINE));
1765 #endif
1766 #ifdef SO_NO_CHECK
1767   scm_c_define ("SO_NO_CHECK", scm_from_int (SO_NO_CHECK));
1768 #endif
1769 #ifdef SO_PRIORITY
1770   scm_c_define ("SO_PRIORITY", scm_from_int (SO_PRIORITY));
1771 #endif
1772 #ifdef SO_LINGER
1773   scm_c_define ("SO_LINGER", scm_from_int (SO_LINGER));
1774 #endif
1775
1776   /* recv/send options.  */
1777 #ifdef MSG_DONTWAIT
1778   scm_c_define ("MSG_DONTWAIT", scm_from_int (MSG_DONTWAIT));
1779 #endif
1780 #ifdef MSG_OOB
1781   scm_c_define ("MSG_OOB", scm_from_int (MSG_OOB));
1782 #endif
1783 #ifdef MSG_PEEK
1784   scm_c_define ("MSG_PEEK", scm_from_int (MSG_PEEK));
1785 #endif
1786 #ifdef MSG_DONTROUTE
1787   scm_c_define ("MSG_DONTROUTE", scm_from_int (MSG_DONTROUTE));
1788 #endif
1789
1790 #ifdef __MINGW32__
1791   scm_i_init_socket_Win32 ();
1792 #endif
1793
1794 #ifdef IP_ADD_MEMBERSHIP
1795   scm_c_define ("IP_ADD_MEMBERSHIP", scm_from_int (IP_ADD_MEMBERSHIP));
1796   scm_c_define ("IP_DROP_MEMBERSHIP", scm_from_int (IP_DROP_MEMBERSHIP));
1797 #endif
1798
1799   scm_add_feature ("socket");
1800
1801 #include "libguile/socket.x"
1802 }
1803
1804
1805 /*
1806   Local Variables:
1807   c-file-style: "gnu"
1808   End:
1809 */