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