1 /* Copyright (C) 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005,
2 * 2006, 2007, 2009, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
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.
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.
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
39 #include <sys/types.h>
40 #include <sys/socket.h>
41 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
44 #include <netinet/in.h>
46 #include <arpa/inet.h>
50 #include "libguile/_scm.h"
51 #include "libguile/arrays.h"
52 #include "libguile/feature.h"
53 #include "libguile/fports.h"
54 #include "libguile/strings.h"
55 #include "libguile/vectors.h"
56 #include "libguile/dynwind.h"
57 #include "libguile/srfi-13.h"
59 #include "libguile/validate.h"
60 #include "libguile/socket.h"
62 #if SCM_ENABLE_DEPRECATED == 1
63 # include "libguile/deprecation.h"
68 #if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
69 #define SUN_LEN(ptr) ((size_t) (((struct sockaddr_un *) 0)->sun_path) \
70 + strlen ((ptr)->sun_path))
73 /* The largest possible socket address. Wrapping it in a union guarantees
74 that the compiler will make it suitably aligned. */
77 struct sockaddr sockaddr
;
78 struct sockaddr_in sockaddr_in
;
80 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
81 struct sockaddr_un sockaddr_un
;
84 struct sockaddr_in6 sockaddr_in6
;
89 /* Maximum size of a socket address. */
90 #define MAX_ADDR_SIZE (sizeof (scm_t_max_sockaddr))
95 #ifdef HAVE_INET_NETOF
96 SCM_DEFINE (scm_inet_netof
, "inet-netof", 1, 0, 0,
98 "Return the network number part of the given IPv4\n"
99 "Internet address. E.g.,\n\n"
101 "(inet-netof 2130706433) @result{} 127\n"
103 #define FUNC_NAME s_scm_inet_netof
106 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
107 return scm_from_ulong (inet_netof (addr
));
112 #ifdef HAVE_INET_LNAOF
113 SCM_DEFINE (scm_lnaof
, "inet-lnaof", 1, 0, 0,
115 "Return the local-address-with-network part of the given\n"
116 "IPv4 Internet address, using the obsolete class A/B/C system.\n"
119 "(inet-lnaof 2130706433) @result{} 1\n"
121 #define FUNC_NAME s_scm_lnaof
124 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
125 return scm_from_ulong (inet_lnaof (addr
));
130 #ifdef HAVE_INET_MAKEADDR
131 SCM_DEFINE (scm_inet_makeaddr
, "inet-makeaddr", 2, 0, 0,
133 "Make an IPv4 Internet address by combining the network number\n"
134 "@var{net} with the local-address-within-network number\n"
135 "@var{lna}. E.g.,\n\n"
137 "(inet-makeaddr 127 1) @result{} 2130706433\n"
139 #define FUNC_NAME s_scm_inet_makeaddr
142 unsigned long netnum
;
143 unsigned long lnanum
;
145 netnum
= SCM_NUM2ULONG (1, net
);
146 lnanum
= SCM_NUM2ULONG (2, lna
);
147 addr
= inet_makeaddr (netnum
, lnanum
);
148 return scm_from_ulong (ntohl (addr
.s_addr
));
155 /* flip a 128 bit IPv6 address between host and network order. */
156 #ifdef WORDS_BIGENDIAN
157 #define FLIP_NET_HOST_128(addr)
159 #define FLIP_NET_HOST_128(addr)\
163 for (i = 0; i < 8; i++)\
165 scm_t_uint8 c = (addr)[i];\
167 (addr)[i] = (addr)[15 - i];\
173 #ifdef WORDS_BIGENDIAN
174 #define FLIPCPY_NET_HOST_128(dest, src) memcpy (dest, src, 16)
176 #define FLIPCPY_NET_HOST_128(dest, src) \
178 const scm_t_uint8 *tmp_srcp = (src) + 15; \
179 scm_t_uint8 *tmp_destp = (dest); \
182 *tmp_destp++ = *tmp_srcp--; \
183 } while (tmp_srcp != (src)); \
188 #if (SIZEOF_SCM_T_BITS * SCM_CHAR_BIT) > 128
189 #error "Assumption that scm_t_bits <= 128 bits has been violated."
192 #if (SIZEOF_UNSIGNED_LONG * SCM_CHAR_BIT) > 128
193 #error "Assumption that unsigned long <= 128 bits has been violated."
196 #if (SIZEOF_UNSIGNED_LONG_LONG * SCM_CHAR_BIT) > 128
197 #error "Assumption that unsigned long long <= 128 bits has been violated."
200 /* convert a 128 bit IPv6 address in network order to a host ordered
203 scm_from_ipv6 (const scm_t_uint8
*src
)
205 SCM result
= scm_i_mkbig ();
206 mpz_import (SCM_I_BIG_MPZ (result
),
208 1, /* big-endian chunk ordering */
209 16, /* chunks are 16 bytes long */
210 1, /* big-endian byte ordering */
211 0, /* "nails" -- leading unused bits per chunk */
213 return scm_i_normbig (result
);
216 /* convert a host ordered SCM integer to a 128 bit IPv6 address in
219 scm_to_ipv6 (scm_t_uint8 dst
[16], SCM src
)
221 if (SCM_I_INUMP (src
))
223 scm_t_signed_bits n
= SCM_I_INUM (src
);
225 scm_out_of_range (NULL
, src
);
226 #ifdef WORDS_BIGENDIAN
227 memset (dst
, 0, 16 - sizeof (scm_t_signed_bits
));
228 memcpy (dst
+ (16 - sizeof (scm_t_signed_bits
)),
230 sizeof (scm_t_signed_bits
));
232 memset (dst
+ sizeof (scm_t_signed_bits
),
234 16 - sizeof (scm_t_signed_bits
));
235 /* FIXME: this pair of ops is kinda wasteful -- should rewrite as
236 a single loop perhaps, similar to the handling of bignums. */
237 memcpy (dst
, &n
, sizeof (scm_t_signed_bits
));
238 FLIP_NET_HOST_128 (dst
);
241 else if (SCM_BIGP (src
))
245 if ((mpz_sgn (SCM_I_BIG_MPZ (src
)) < 0)
246 || mpz_sizeinbase (SCM_I_BIG_MPZ (src
), 2) > 128)
247 scm_out_of_range (NULL
, src
);
252 1, /* big-endian chunk ordering */
253 16, /* chunks are 16 bytes long */
254 1, /* big-endian byte ordering */
255 0, /* "nails" -- leading unused bits per chunk */
256 SCM_I_BIG_MPZ (src
));
257 scm_remember_upto_here_1 (src
);
260 scm_wrong_type_arg_msg ("scm_to_ipv6", 0, src
, "integer");
263 #endif /* HAVE_IPV6 */
267 SCM_DEFINE (scm_inet_ntop
, "inet-ntop", 2, 0, 0,
268 (SCM family
, SCM address
),
269 "Convert a network address into a printable string.\n"
270 "Note that unlike the C version of this function,\n"
271 "the input is an integer with normal host byte ordering.\n"
272 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
274 "(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
275 "(inet-ntop AF_INET6 (- (expt 2 128) 1))\n"
276 " @result{} \"ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\"\n"
278 #define FUNC_NAME s_scm_inet_ntop
281 #ifdef INET6_ADDRSTRLEN
282 char dst
[INET6_ADDRSTRLEN
];
288 af
= scm_to_int (family
);
289 SCM_ASSERT_RANGE (1, family
,
299 addr4
= htonl (SCM_NUM2ULONG (2, address
));
300 result
= inet_ntop (af
, &addr4
, dst
, sizeof (dst
));
303 else if (af
== AF_INET6
)
307 scm_to_ipv6 ((scm_t_uint8
*) addr6
, address
);
308 result
= inet_ntop (af
, &addr6
, dst
, sizeof (dst
));
312 SCM_MISC_ERROR ("unsupported address family", family
);
317 return scm_from_locale_string (dst
);
321 SCM_DEFINE (scm_inet_pton
, "inet-pton", 2, 0, 0,
322 (SCM family
, SCM address
),
323 "Convert a string containing a printable network address to\n"
324 "an integer address. Note that unlike the C version of this\n"
326 "the result is an integer with normal host byte ordering.\n"
327 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
329 "(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
330 "(inet-pton AF_INET6 \"::1\") @result{} 1\n"
332 #define FUNC_NAME s_scm_inet_pton
339 af
= scm_to_int (family
);
340 SCM_ASSERT_RANGE (1, family
,
347 src
= scm_to_locale_string (address
);
348 rv
= inet_pton (af
, src
, dst
);
356 SCM_MISC_ERROR ("Bad address", SCM_EOL
);
358 return scm_from_ulong (ntohl (*dst
));
360 else if (af
== AF_INET6
)
361 return scm_from_ipv6 ((scm_t_uint8
*) dst
);
364 SCM_MISC_ERROR ("unsupported address family", family
);
369 SCM_SYMBOL (sym_socket
, "socket");
371 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
373 SCM_DEFINE (scm_socket
, "socket", 3, 0, 0,
374 (SCM family
, SCM style
, SCM proto
),
375 "Return a new socket port of the type specified by @var{family},\n"
376 "@var{style} and @var{proto}. All three parameters are\n"
377 "integers. Supported values for @var{family} are\n"
378 "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
379 "Typical values for @var{style} are @code{SOCK_STREAM},\n"
380 "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
381 "@var{proto} can be obtained from a protocol name using\n"
382 "@code{getprotobyname}. A value of zero specifies the default\n"
383 "protocol, which is usually right.\n\n"
384 "A single socket port cannot by used for communication until it\n"
385 "has been connected to another socket.")
386 #define FUNC_NAME s_scm_socket
390 fd
= socket (scm_to_int (family
),
395 return SCM_SOCK_FD_TO_PORT (fd
);
399 #ifdef HAVE_SOCKETPAIR
400 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
401 (SCM family
, SCM style
, SCM proto
),
402 "Return a pair of connected (but unnamed) socket ports of the\n"
403 "type specified by @var{family}, @var{style} and @var{proto}.\n"
404 "Many systems support only socket pairs of the @code{AF_UNIX}\n"
405 "family. Zero is likely to be the only meaningful value for\n"
407 #define FUNC_NAME s_scm_socketpair
412 fam
= scm_to_int (family
);
414 if (socketpair (fam
, scm_to_int (style
), scm_to_int (proto
), fd
) == -1)
417 return scm_cons (SCM_SOCK_FD_TO_PORT (fd
[0]), SCM_SOCK_FD_TO_PORT (fd
[1]));
422 /* Possible results for `getsockopt ()'. Wrapping it into a union guarantees
423 suitable alignment. */
426 #ifdef HAVE_STRUCT_LINGER
427 struct linger linger
;
431 } scm_t_getsockopt_result
;
433 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
434 (SCM sock
, SCM level
, SCM optname
),
435 "Return an option value from socket port @var{sock}.\n"
437 "@var{level} is an integer specifying a protocol layer, either\n"
438 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
439 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
440 "(@pxref{Network Databases}).\n"
442 "@defvar SOL_SOCKET\n"
443 "@defvarx IPPROTO_IP\n"
444 "@defvarx IPPROTO_TCP\n"
445 "@defvarx IPPROTO_UDP\n"
448 "@var{optname} is an integer specifying an option within the\n"
451 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
452 "defined (when provided by the system). For their meaning see\n"
453 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
454 "Manual}, or @command{man 7 socket}.\n"
457 "@defvarx SO_REUSEADDR\n"
458 "@defvarx SO_STYLE\n"
460 "@defvarx SO_ERROR\n"
461 "@defvarx SO_DONTROUTE\n"
462 "@defvarx SO_BROADCAST\n"
463 "@defvarx SO_SNDBUF\n"
464 "@defvarx SO_RCVBUF\n"
465 "@defvarx SO_KEEPALIVE\n"
466 "@defvarx SO_OOBINLINE\n"
467 "@defvarx SO_NO_CHECK\n"
468 "@defvarx SO_PRIORITY\n"
469 "@defvarx SO_REUSEPORT\n"
470 "The value returned is an integer.\n"
473 "@defvar SO_LINGER\n"
474 "The value returned is a pair of integers\n"
475 "@code{(@var{enable} . @var{timeout})}. On old systems without\n"
476 "timeout support (ie.@: without @code{struct linger}), only\n"
477 "@var{enable} has an effect but the value in Guile is always a\n"
480 #define FUNC_NAME s_scm_getsockopt
483 /* size of optval is the largest supported option. */
484 scm_t_getsockopt_result optval
;
485 socklen_t optlen
= sizeof (optval
);
489 sock
= SCM_COERCE_OUTPORT (sock
);
490 SCM_VALIDATE_OPFPORT (1, sock
);
491 ilevel
= scm_to_int (level
);
492 ioptname
= scm_to_int (optname
);
494 fd
= SCM_FPORT_FDES (sock
);
495 if (getsockopt (fd
, ilevel
, ioptname
, (void *) &optval
, &optlen
) == -1)
498 if (ilevel
== SOL_SOCKET
)
501 if (ioptname
== SO_LINGER
)
503 #ifdef HAVE_STRUCT_LINGER
504 struct linger
*ling
= (struct linger
*) &optval
;
506 return scm_cons (scm_from_long (ling
->l_onoff
),
507 scm_from_long (ling
->l_linger
));
509 return scm_cons (scm_from_long (*(int *) &optval
),
517 || ioptname
== SO_SNDBUF
520 || ioptname
== SO_RCVBUF
524 return scm_from_size_t (*(size_t *) &optval
);
527 return scm_from_int (*(int *) &optval
);
531 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
532 (SCM sock
, SCM level
, SCM optname
, SCM value
),
533 "Set an option on socket port @var{sock}. The return value is\n"
536 "@var{level} is an integer specifying a protocol layer, either\n"
537 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
538 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
539 "(@pxref{Network Databases}).\n"
541 "@defvar SOL_SOCKET\n"
542 "@defvarx IPPROTO_IP\n"
543 "@defvarx IPPROTO_TCP\n"
544 "@defvarx IPPROTO_UDP\n"
547 "@var{optname} is an integer specifying an option within the\n"
550 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
551 "defined (when provided by the system). For their meaning see\n"
552 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
553 "Manual}, or @command{man 7 socket}.\n"
556 "@defvarx SO_REUSEADDR\n"
557 "@defvarx SO_STYLE\n"
559 "@defvarx SO_ERROR\n"
560 "@defvarx SO_DONTROUTE\n"
561 "@defvarx SO_BROADCAST\n"
562 "@defvarx SO_SNDBUF\n"
563 "@defvarx SO_RCVBUF\n"
564 "@defvarx SO_KEEPALIVE\n"
565 "@defvarx SO_OOBINLINE\n"
566 "@defvarx SO_NO_CHECK\n"
567 "@defvarx SO_PRIORITY\n"
568 "@defvarx SO_REUSEPORT\n"
569 "@var{value} is an integer.\n"
572 "@defvar SO_LINGER\n"
573 "@var{value} is a pair of integers @code{(@var{ENABLE}\n"
574 ". @var{TIMEOUT})}. On old systems without timeout support\n"
575 "(ie.@: without @code{struct linger}), only @var{ENABLE} has an\n"
576 "effect but the value in Guile is always a pair.\n"
579 "@c Note that we refer only to ``man ip'' here. On GNU/Linux it's\n"
580 "@c ``man 7 ip'' but on NetBSD it's ``man 4 ip''.\n"
582 "For IP level (@code{IPPROTO_IP}) the following @var{optname}s\n"
583 "are defined (when provided by the system). See @command{man\n"
584 "ip} for what they mean.\n"
586 "@defvar IP_MULTICAST_IF\n"
587 "This sets the source interface used by multicast traffic.\n"
590 "@defvar IP_MULTICAST_TTL\n"
591 "This sets the default TTL for multicast traffic. This defaults \n"
592 "to 1 and should be increased to allow traffic to pass beyond the\n"
596 "@defvar IP_ADD_MEMBERSHIP\n"
597 "@defvarx IP_DROP_MEMBERSHIP\n"
598 "These can be used only with @code{setsockopt}, not\n"
599 "@code{getsockopt}. @var{value} is a pair\n"
600 "@code{(@var{MULTIADDR} . @var{INTERFACEADDR})} of IPv4\n"
601 "addresses (@pxref{Network Address Conversion}).\n"
602 "@var{MULTIADDR} is a multicast address to be added to or\n"
603 "dropped from the interface @var{INTERFACEADDR}.\n"
604 "@var{INTERFACEADDR} can be @code{INADDR_ANY} to have the system\n"
605 "select the interface. @var{INTERFACEADDR} can also be an\n"
606 "interface index number, on systems supporting that.\n"
608 #define FUNC_NAME s_scm_setsockopt
613 #ifdef HAVE_STRUCT_LINGER
614 struct linger opt_linger
;
617 #ifdef HAVE_STRUCT_IP_MREQ
618 struct ip_mreq opt_mreq
;
621 const void *optval
= NULL
;
622 socklen_t optlen
= 0;
624 int ilevel
, ioptname
;
626 sock
= SCM_COERCE_OUTPORT (sock
);
628 SCM_VALIDATE_OPFPORT (1, sock
);
629 ilevel
= scm_to_int (level
);
630 ioptname
= scm_to_int (optname
);
632 fd
= SCM_FPORT_FDES (sock
);
634 if (ilevel
== SOL_SOCKET
)
637 if (ioptname
== SO_LINGER
)
639 #ifdef HAVE_STRUCT_LINGER
640 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
641 opt_linger
.l_onoff
= scm_to_int (SCM_CAR (value
));
642 opt_linger
.l_linger
= scm_to_int (SCM_CDR (value
));
643 optlen
= sizeof (struct linger
);
644 optval
= &opt_linger
;
646 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
647 opt_int
= scm_to_int (SCM_CAR (value
));
648 /* timeout is ignored, but may as well validate it. */
649 scm_to_int (SCM_CDR (value
));
650 optlen
= sizeof (int);
658 || ioptname
== SO_SNDBUF
661 || ioptname
== SO_RCVBUF
665 opt_int
= scm_to_int (value
);
666 optlen
= sizeof (size_t);
671 #ifdef HAVE_STRUCT_IP_MREQ
672 if (ilevel
== IPPROTO_IP
&&
673 (ioptname
== IP_ADD_MEMBERSHIP
|| ioptname
== IP_DROP_MEMBERSHIP
))
675 /* Fourth argument must be a pair of addresses. */
676 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
677 opt_mreq
.imr_multiaddr
.s_addr
= htonl (scm_to_ulong (SCM_CAR (value
)));
678 opt_mreq
.imr_interface
.s_addr
= htonl (scm_to_ulong (SCM_CDR (value
)));
679 optlen
= sizeof (opt_mreq
);
686 /* Most options take an int. */
687 opt_int
= scm_to_int (value
);
688 optlen
= sizeof (int);
692 if (setsockopt (fd
, ilevel
, ioptname
, optval
, optlen
) == -1)
694 return SCM_UNSPECIFIED
;
698 /* Our documentation hard-codes this mapping, so make sure it holds. */
699 verify (SHUT_RD
== 0);
700 verify (SHUT_WR
== 1);
701 verify (SHUT_RDWR
== 2);
703 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
705 "Sockets can be closed simply by using @code{close-port}. The\n"
706 "@code{shutdown} procedure allows reception or transmission on a\n"
707 "connection to be shut down individually, according to the parameter\n"
711 "Stop receiving data for this socket. If further data arrives, reject it.\n"
713 "Stop trying to transmit data from this socket. Discard any\n"
714 "data waiting to be sent. Stop looking for acknowledgement of\n"
715 "data already sent; don't retransmit it if it is lost.\n"
717 "Stop both reception and transmission.\n"
719 "The return value is unspecified.")
720 #define FUNC_NAME s_scm_shutdown
723 sock
= SCM_COERCE_OUTPORT (sock
);
724 SCM_VALIDATE_OPFPORT (1, sock
);
725 fd
= SCM_FPORT_FDES (sock
);
726 if (shutdown (fd
, scm_to_signed_integer (how
, 0, 2)) == -1)
728 return SCM_UNSPECIFIED
;
732 /* convert fam/address/args into a sockaddr of the appropriate type.
733 args is modified by removing the arguments actually used.
734 which_arg and proc are used when reporting errors:
735 which_arg is the position of address in the original argument list.
736 proc is the name of the original procedure.
737 size returns the size of the structure allocated. */
739 static struct sockaddr
*
740 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
741 const char *proc
, size_t *size
)
742 #define FUNC_NAME proc
748 struct sockaddr_in
*soka
;
752 SCM_VALIDATE_ULONG_COPY (which_arg
, address
, addr
);
753 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
754 port
= scm_to_int (SCM_CAR (*args
));
755 *args
= SCM_CDR (*args
);
756 soka
= (struct sockaddr_in
*) scm_malloc (sizeof (struct sockaddr_in
));
757 memset (soka
, '\0', sizeof (struct sockaddr_in
));
759 #ifdef HAVE_STRUCT_SOCKADDR_IN_SIN_LEN
760 soka
->sin_len
= sizeof (struct sockaddr_in
);
762 soka
->sin_family
= AF_INET
;
763 soka
->sin_addr
.s_addr
= htonl (addr
);
764 soka
->sin_port
= htons (port
);
765 *size
= sizeof (struct sockaddr_in
);
766 return (struct sockaddr
*) soka
;
773 struct sockaddr_in6
*soka
;
774 unsigned long flowinfo
= 0;
775 unsigned long scope_id
= 0;
777 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
778 port
= scm_to_int (SCM_CAR (*args
));
779 *args
= SCM_CDR (*args
);
780 if (scm_is_pair (*args
))
782 SCM_VALIDATE_ULONG_COPY (which_arg
+ 2, SCM_CAR (*args
), flowinfo
);
783 *args
= SCM_CDR (*args
);
784 if (scm_is_pair (*args
))
786 SCM_VALIDATE_ULONG_COPY (which_arg
+ 3, SCM_CAR (*args
),
788 *args
= SCM_CDR (*args
);
791 soka
= (struct sockaddr_in6
*) scm_malloc (sizeof (struct sockaddr_in6
));
793 #ifdef HAVE_STRUCT_SOCKADDR_IN6_SIN6_LEN
794 soka
->sin6_len
= sizeof (struct sockaddr_in6
);
796 soka
->sin6_family
= AF_INET6
;
797 scm_to_ipv6 (soka
->sin6_addr
.s6_addr
, address
);
798 soka
->sin6_port
= htons (port
);
799 soka
->sin6_flowinfo
= flowinfo
;
800 #ifdef HAVE_SIN6_SCOPE_ID
801 soka
->sin6_scope_id
= scope_id
;
803 *size
= sizeof (struct sockaddr_in6
);
804 return (struct sockaddr
*) soka
;
807 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
810 struct sockaddr_un
*soka
;
814 scm_dynwind_begin (0);
816 c_address
= scm_to_locale_string (address
);
817 scm_dynwind_free (c_address
);
819 /* the static buffer size in sockaddr_un seems to be arbitrary
820 and not necessarily a hard limit. e.g., the glibc manual
821 suggests it may be possible to declare it size 0. let's
822 ignore it. if the O/S doesn't like the size it will cause
823 connect/bind etc., to fail. sun_path is always the last
824 member of the structure. */
825 addr_size
= sizeof (struct sockaddr_un
)
826 + max (0, strlen (c_address
) + 1 - (sizeof soka
->sun_path
));
827 soka
= (struct sockaddr_un
*) scm_malloc (addr_size
);
828 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
829 soka
->sun_family
= AF_UNIX
;
830 strcpy (soka
->sun_path
, c_address
);
831 *size
= SUN_LEN (soka
);
834 return (struct sockaddr
*) soka
;
838 scm_out_of_range (proc
, scm_from_int (fam
));
843 SCM_DEFINE (scm_connect
, "connect", 2, 1, 1,
844 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
845 "Initiate a connection from a socket using a specified address\n"
846 "family to the address\n"
847 "specified by @var{address} and possibly @var{args}.\n"
848 "The format required for @var{address}\n"
849 "and @var{args} depends on the family of the socket.\n\n"
850 "For a socket of family @code{AF_UNIX},\n"
851 "only @var{address} is specified and must be a string with the\n"
852 "filename where the socket is to be created.\n\n"
853 "For a socket of family @code{AF_INET},\n"
854 "@var{address} must be an integer IPv4 host address and\n"
855 "@var{args} must be a single integer port number.\n\n"
856 "For a socket of family @code{AF_INET6},\n"
857 "@var{address} must be an integer IPv6 host address and\n"
858 "@var{args} may be up to three integers:\n"
859 "port [flowinfo] [scope_id],\n"
860 "where flowinfo and scope_id default to zero.\n\n"
861 "Alternatively, the second argument can be a socket address object "
862 "as returned by @code{make-socket-address}, in which case the "
863 "no additional arguments should be passed.\n\n"
864 "The return value is unspecified.")
865 #define FUNC_NAME s_scm_connect
868 struct sockaddr
*soka
;
871 sock
= SCM_COERCE_OUTPORT (sock
);
872 SCM_VALIDATE_OPFPORT (1, sock
);
873 fd
= SCM_FPORT_FDES (sock
);
875 if (scm_is_eq (address
, SCM_UNDEFINED
))
876 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
877 `socket address' object. */
878 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
880 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
881 &args
, 3, FUNC_NAME
, &size
);
883 if (connect (fd
, soka
, size
) == -1)
885 int save_errno
= errno
;
892 return SCM_UNSPECIFIED
;
896 SCM_DEFINE (scm_bind
, "bind", 2, 1, 1,
897 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
898 "Assign an address to the socket port @var{sock}.\n"
899 "Generally this only needs to be done for server sockets,\n"
900 "so they know where to look for incoming connections. A socket\n"
901 "without an address will be assigned one automatically when it\n"
902 "starts communicating.\n\n"
903 "The format of @var{address} and @var{args} depends\n"
904 "on the family of the socket.\n\n"
905 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
906 "is specified and must be a string with the filename where\n"
907 "the socket is to be created.\n\n"
908 "For a socket of family @code{AF_INET}, @var{address}\n"
909 "must be an integer IPv4 address and @var{args}\n"
910 "must be a single integer port number.\n\n"
911 "The values of the following variables can also be used for\n"
913 "@defvar INADDR_ANY\n"
914 "Allow connections from any address.\n"
916 "@defvar INADDR_LOOPBACK\n"
917 "The address of the local host using the loopback device.\n"
919 "@defvar INADDR_BROADCAST\n"
920 "The broadcast address on the local network.\n"
922 "@defvar INADDR_NONE\n"
925 "For a socket of family @code{AF_INET6}, @var{address}\n"
926 "must be an integer IPv6 address and @var{args}\n"
927 "may be up to three integers:\n"
928 "port [flowinfo] [scope_id],\n"
929 "where flowinfo and scope_id default to zero.\n\n"
930 "Alternatively, the second argument can be a socket address object "
931 "as returned by @code{make-socket-address}, in which case the "
932 "no additional arguments should be passed.\n\n"
933 "The return value is unspecified.")
934 #define FUNC_NAME s_scm_bind
936 struct sockaddr
*soka
;
940 sock
= SCM_COERCE_OUTPORT (sock
);
941 SCM_VALIDATE_OPFPORT (1, sock
);
942 fd
= SCM_FPORT_FDES (sock
);
944 if (scm_is_eq (address
, SCM_UNDEFINED
))
945 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
946 `socket address' object. */
947 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
949 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
950 &args
, 3, FUNC_NAME
, &size
);
953 if (bind (fd
, soka
, size
) == -1)
955 int save_errno
= errno
;
962 return SCM_UNSPECIFIED
;
966 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
967 (SCM sock
, SCM backlog
),
968 "Enable @var{sock} to accept connection\n"
969 "requests. @var{backlog} is an integer specifying\n"
970 "the maximum length of the queue for pending connections.\n"
971 "If the queue fills, new clients will fail to connect until\n"
972 "the server calls @code{accept} to accept a connection from\n"
974 "The return value is unspecified.")
975 #define FUNC_NAME s_scm_listen
978 sock
= SCM_COERCE_OUTPORT (sock
);
979 SCM_VALIDATE_OPFPORT (1, sock
);
980 fd
= SCM_FPORT_FDES (sock
);
981 if (listen (fd
, scm_to_int (backlog
)) == -1)
983 return SCM_UNSPECIFIED
;
987 /* Put the components of a sockaddr into a new SCM vector. */
988 static SCM_C_INLINE_KEYWORD SCM
989 _scm_from_sockaddr (const scm_t_max_sockaddr
*address
, unsigned addr_size
,
992 SCM result
= SCM_EOL
;
993 short int fam
= ((struct sockaddr
*) address
)->sa_family
;
999 const struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
1001 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
1003 SCM_SIMPLE_VECTOR_SET(result
, 0,
1004 scm_from_short (fam
));
1005 SCM_SIMPLE_VECTOR_SET(result
, 1,
1006 scm_from_ulong (ntohl (nad
->sin_addr
.s_addr
)));
1007 SCM_SIMPLE_VECTOR_SET(result
, 2,
1008 scm_from_ushort (ntohs (nad
->sin_port
)));
1014 const struct sockaddr_in6
*nad
= (struct sockaddr_in6
*) address
;
1016 result
= scm_c_make_vector (5, SCM_UNSPECIFIED
);
1017 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1018 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_ipv6 (nad
->sin6_addr
.s6_addr
));
1019 SCM_SIMPLE_VECTOR_SET(result
, 2, scm_from_ushort (ntohs (nad
->sin6_port
)));
1020 SCM_SIMPLE_VECTOR_SET(result
, 3, scm_from_uint32 (nad
->sin6_flowinfo
));
1021 #ifdef HAVE_SIN6_SCOPE_ID
1022 SCM_SIMPLE_VECTOR_SET(result
, 4, scm_from_ulong (nad
->sin6_scope_id
));
1024 SCM_SIMPLE_VECTOR_SET(result
, 4, SCM_INUM0
);
1029 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1032 const struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
1034 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
1036 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1037 /* When addr_size is not enough to cover sun_path, do not try
1039 if (addr_size
<= offsetof (struct sockaddr_un
, sun_path
))
1040 SCM_SIMPLE_VECTOR_SET(result
, 1, SCM_BOOL_F
);
1042 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_locale_string (nad
->sun_path
));
1047 result
= SCM_UNSPECIFIED
;
1048 scm_misc_error (proc
, "unrecognised address family: ~A",
1049 scm_list_1 (scm_from_int (fam
)));
1055 /* The publicly-visible function. Return a Scheme object representing
1056 ADDRESS, an address of ADDR_SIZE bytes. */
1058 scm_from_sockaddr (const struct sockaddr
*address
, unsigned addr_size
)
1060 return (_scm_from_sockaddr ((scm_t_max_sockaddr
*) address
,
1061 addr_size
, "scm_from_sockaddr"));
1064 /* Convert ADDRESS, an address object returned by either
1065 `scm_from_sockaddr ()' or `scm_make_socket_address ()', into its C
1066 representation. On success, a non-NULL pointer is returned and
1067 ADDRESS_SIZE is updated to the actual size (in bytes) of the returned
1068 address. The result must eventually be freed using `free ()'. */
1070 scm_to_sockaddr (SCM address
, size_t *address_size
)
1071 #define FUNC_NAME "scm_to_sockaddr"
1074 struct sockaddr
*c_address
= NULL
;
1076 SCM_VALIDATE_VECTOR (1, address
);
1079 family
= scm_to_short (SCM_SIMPLE_VECTOR_REF (address
, 0));
1085 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 3)
1086 scm_misc_error (FUNC_NAME
,
1087 "invalid inet address representation: ~A",
1088 scm_list_1 (address
));
1091 struct sockaddr_in c_inet
;
1093 memset (&c_inet
, '\0', sizeof (struct sockaddr_in
));
1095 #ifdef HAVE_STRUCT_SOCKADDR_IN_SIN_LEN
1096 c_inet
.sin_len
= sizeof (struct sockaddr_in
);
1099 c_inet
.sin_addr
.s_addr
=
1100 htonl (scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 1)));
1102 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1103 c_inet
.sin_family
= AF_INET
;
1105 *address_size
= sizeof (c_inet
);
1106 c_address
= scm_malloc (sizeof (c_inet
));
1107 memcpy (c_address
, &c_inet
, sizeof (c_inet
));
1116 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 5)
1117 scm_misc_error (FUNC_NAME
, "invalid inet6 address representation: ~A",
1118 scm_list_1 (address
));
1121 struct sockaddr_in6 c_inet6
;
1123 scm_to_ipv6 (c_inet6
.sin6_addr
.s6_addr
,
1124 SCM_SIMPLE_VECTOR_REF (address
, 1));
1126 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1127 c_inet6
.sin6_flowinfo
=
1128 scm_to_uint32 (SCM_SIMPLE_VECTOR_REF (address
, 3));
1129 #ifdef HAVE_SIN6_SCOPE_ID
1130 c_inet6
.sin6_scope_id
=
1131 scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 4));
1134 c_inet6
.sin6_family
= AF_INET6
;
1136 *address_size
= sizeof (c_inet6
);
1137 c_address
= scm_malloc (sizeof (c_inet6
));
1138 memcpy (c_address
, &c_inet6
, sizeof (c_inet6
));
1145 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1148 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 2)
1149 scm_misc_error (FUNC_NAME
, "invalid unix address representation: ~A",
1150 scm_list_1 (address
));
1154 size_t path_len
= 0;
1156 path
= SCM_SIMPLE_VECTOR_REF (address
, 1);
1157 if (!scm_is_string (path
) && !scm_is_false (path
))
1158 scm_misc_error (FUNC_NAME
, "invalid unix address "
1159 "path: ~A", scm_list_1 (path
));
1162 struct sockaddr_un c_unix
;
1164 if (scm_is_false (path
))
1167 path_len
= scm_c_string_length (path
);
1169 #ifdef UNIX_PATH_MAX
1170 if (path_len
>= UNIX_PATH_MAX
)
1172 /* We can hope that this limit will eventually vanish, at least on GNU.
1173 However, currently, while glibc doesn't define `UNIX_PATH_MAX', it
1174 documents it has being limited to 108 bytes. */
1175 if (path_len
>= sizeof (c_unix
.sun_path
))
1177 scm_misc_error (FUNC_NAME
, "unix address path "
1178 "too long: ~A", scm_list_1 (path
));
1183 scm_to_locale_stringbuf (path
, c_unix
.sun_path
,
1184 #ifdef UNIX_PATH_MAX
1187 sizeof (c_unix
.sun_path
));
1189 c_unix
.sun_path
[path_len
] = '\0';
1192 if (strlen (c_unix
.sun_path
) != path_len
)
1193 scm_misc_error (FUNC_NAME
, "unix address path "
1194 "contains nul characters: ~A",
1198 c_unix
.sun_path
[0] = '\0';
1200 c_unix
.sun_family
= AF_UNIX
;
1202 *address_size
= SUN_LEN (&c_unix
);
1203 c_address
= scm_malloc (sizeof (c_unix
));
1204 memcpy (c_address
, &c_unix
, sizeof (c_unix
));
1214 scm_misc_error (FUNC_NAME
, "unrecognised address family: ~A",
1215 scm_list_1 (scm_from_ushort (family
)));
1223 /* Return a newly-allocated `sockaddr' structure that reflects ADDRESS, being
1224 an address of family FAMILY, with the family-specific parameters ARGS (see
1225 the description of `connect' for details). The returned structure may be
1226 freed using `free ()'. */
1228 scm_c_make_socket_address (SCM family
, SCM address
, SCM args
,
1229 size_t *address_size
)
1231 struct sockaddr
*soka
;
1233 soka
= scm_fill_sockaddr (scm_to_ushort (family
), address
, &args
, 1,
1234 "scm_c_make_socket_address", address_size
);
1239 SCM_DEFINE (scm_make_socket_address
, "make-socket-address", 2, 0, 1,
1240 (SCM family
, SCM address
, SCM args
),
1241 "Return a Scheme address object that reflects @var{address}, "
1242 "being an address of family @var{family}, with the "
1243 "family-specific parameters @var{args} (see the description of "
1244 "@code{connect} for details).")
1245 #define FUNC_NAME s_scm_make_socket_address
1247 SCM result
= SCM_BOOL_F
;
1248 struct sockaddr
*c_address
;
1249 size_t c_address_size
;
1251 c_address
= scm_c_make_socket_address (family
, address
, args
,
1253 if (c_address
!= NULL
)
1255 result
= scm_from_sockaddr (c_address
, c_address_size
);
1264 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
1266 "Accept a connection on a bound, listening socket.\n"
1268 "are no pending connections in the queue, wait until\n"
1269 "one is available unless the non-blocking option has been\n"
1270 "set on the socket.\n\n"
1271 "The return value is a\n"
1272 "pair in which the @emph{car} is a new socket port for the\n"
1274 "the @emph{cdr} is an object with address information about the\n"
1275 "client which initiated the connection.\n\n"
1276 "@var{sock} does not become part of the\n"
1277 "connection and will continue to accept new requests.")
1278 #define FUNC_NAME s_scm_accept
1284 socklen_t addr_size
= MAX_ADDR_SIZE
;
1285 scm_t_max_sockaddr addr
;
1287 sock
= SCM_COERCE_OUTPORT (sock
);
1288 SCM_VALIDATE_OPFPORT (1, sock
);
1289 fd
= SCM_FPORT_FDES (sock
);
1290 SCM_SYSCALL (newfd
= accept (fd
, (struct sockaddr
*) &addr
, &addr_size
));
1293 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
1294 address
= _scm_from_sockaddr (&addr
, addr_size
,
1297 return scm_cons (newsock
, address
);
1301 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
1303 "Return the address of @var{sock}, in the same form as the\n"
1304 "object returned by @code{accept}. On many systems the address\n"
1305 "of a socket in the @code{AF_FILE} namespace cannot be read.")
1306 #define FUNC_NAME s_scm_getsockname
1309 socklen_t addr_size
= MAX_ADDR_SIZE
;
1310 scm_t_max_sockaddr addr
;
1312 sock
= SCM_COERCE_OUTPORT (sock
);
1313 SCM_VALIDATE_OPFPORT (1, sock
);
1314 fd
= SCM_FPORT_FDES (sock
);
1315 if (getsockname (fd
, (struct sockaddr
*) &addr
, &addr_size
) == -1)
1318 return _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1322 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
1324 "Return the address that @var{sock}\n"
1325 "is connected to, in the same form as the object returned by\n"
1326 "@code{accept}. On many systems the address of a socket in the\n"
1327 "@code{AF_FILE} namespace cannot be read.")
1328 #define FUNC_NAME s_scm_getpeername
1331 socklen_t addr_size
= MAX_ADDR_SIZE
;
1332 scm_t_max_sockaddr addr
;
1334 sock
= SCM_COERCE_OUTPORT (sock
);
1335 SCM_VALIDATE_OPFPORT (1, sock
);
1336 fd
= SCM_FPORT_FDES (sock
);
1337 if (getpeername (fd
, (struct sockaddr
*) &addr
, &addr_size
) == -1)
1340 return _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1344 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
1345 (SCM sock
, SCM buf
, SCM flags
),
1346 "Receive data from a socket port.\n"
1347 "@var{sock} must already\n"
1348 "be bound to the address from which data is to be received.\n"
1349 "@var{buf} is a bytevector into which\n"
1350 "the data will be written. The size of @var{buf} limits\n"
1352 "data which can be received: in the case of packet\n"
1353 "protocols, if a packet larger than this limit is encountered\n"
1355 "will be irrevocably lost.\n\n"
1356 "The optional @var{flags} argument is a value or\n"
1357 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1358 "The value returned is the number of bytes read from the\n"
1360 "Note that the data is read directly from the socket file\n"
1362 "any unread buffered port data is ignored.")
1363 #define FUNC_NAME s_scm_recv
1367 SCM_VALIDATE_OPFPORT (1, sock
);
1369 if (SCM_UNBNDP (flags
))
1372 flg
= scm_to_int (flags
);
1373 fd
= SCM_FPORT_FDES (sock
);
1375 SCM_VALIDATE_BYTEVECTOR (1, buf
);
1377 SCM_SYSCALL (rv
= recv (fd
,
1378 SCM_BYTEVECTOR_CONTENTS (buf
),
1379 SCM_BYTEVECTOR_LENGTH (buf
),
1382 if (SCM_UNLIKELY (rv
== -1))
1385 scm_remember_upto_here (buf
);
1386 return scm_from_int (rv
);
1390 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
1391 (SCM sock
, SCM message
, SCM flags
),
1392 "Transmit bytevector @var{message} on socket port @var{sock}.\n"
1393 "@var{sock} must already be bound to a destination address. The\n"
1394 "value returned is the number of bytes transmitted --\n"
1395 "it's possible for\n"
1396 "this to be less than the length of @var{message}\n"
1397 "if the socket is\n"
1398 "set to be non-blocking. The optional @var{flags} argument\n"
1400 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1401 "Note that the data is written directly to the socket\n"
1402 "file descriptor:\n"
1403 "any unflushed buffered port data is ignored.\n\n"
1404 "This operation is defined only for strings containing codepoints\n"
1406 #define FUNC_NAME s_scm_send
1410 sock
= SCM_COERCE_OUTPORT (sock
);
1411 SCM_VALIDATE_OPFPORT (1, sock
);
1413 if (SCM_UNBNDP (flags
))
1416 flg
= scm_to_int (flags
);
1418 fd
= SCM_FPORT_FDES (sock
);
1420 SCM_VALIDATE_BYTEVECTOR (1, message
);
1422 SCM_SYSCALL (rv
= send (fd
,
1423 SCM_BYTEVECTOR_CONTENTS (message
),
1424 SCM_BYTEVECTOR_LENGTH (message
),
1430 scm_remember_upto_here_1 (message
);
1431 return scm_from_int (rv
);
1435 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
1436 (SCM sock
, SCM buf
, SCM flags
, SCM start
, SCM end
),
1437 "Receive data from socket port @var{sock} (which must be already\n"
1438 "bound), returning the originating address as well as the data.\n"
1439 "This is usually for use on datagram sockets, but can be used on\n"
1440 "stream-oriented sockets too.\n"
1442 "The data received is stored in bytevector @var{buf}, using\n"
1443 "either the whole bytevector or just the region between the optional\n"
1444 "@var{start} and @var{end} positions. The size of @var{buf}\n"
1445 "limits the amount of data that can be received. For datagram\n"
1446 "protocols, if a packet larger than this is received then excess\n"
1447 "bytes are irrevocably lost.\n"
1449 "The return value is a pair. The @code{car} is the number of\n"
1450 "bytes read. The @code{cdr} is a socket address object which is\n"
1451 "where the data came from, or @code{#f} if the origin is\n"
1454 "The optional @var{flags} argument is a or bitwise OR\n"
1455 "(@code{logior}) of @code{MSG_OOB}, @code{MSG_PEEK},\n"
1456 "@code{MSG_DONTROUTE} etc.\n"
1458 "Data is read directly from the socket file descriptor, any\n"
1459 "buffered port data is ignored.\n"
1461 "On a GNU/Linux system @code{recvfrom!} is not multi-threading,\n"
1462 "all threads stop while a @code{recvfrom!} call is in progress.\n"
1463 "An application may need to use @code{select}, @code{O_NONBLOCK}\n"
1464 "or @code{MSG_DONTWAIT} to avoid this.")
1465 #define FUNC_NAME s_scm_recvfrom
1469 size_t offset
, cend
;
1470 socklen_t addr_size
= MAX_ADDR_SIZE
;
1471 scm_t_max_sockaddr addr
;
1473 SCM_VALIDATE_OPFPORT (1, sock
);
1474 fd
= SCM_FPORT_FDES (sock
);
1476 if (SCM_UNBNDP (flags
))
1479 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
1481 ((struct sockaddr
*) &addr
)->sa_family
= AF_UNSPEC
;
1483 SCM_VALIDATE_BYTEVECTOR (1, buf
);
1485 if (SCM_UNBNDP (start
))
1488 offset
= scm_to_size_t (start
);
1490 if (SCM_UNBNDP (end
))
1491 cend
= SCM_BYTEVECTOR_LENGTH (buf
);
1494 cend
= scm_to_size_t (end
);
1495 if (SCM_UNLIKELY (cend
>= SCM_BYTEVECTOR_LENGTH (buf
)
1497 scm_out_of_range (FUNC_NAME
, end
);
1500 SCM_SYSCALL (rv
= recvfrom (fd
,
1501 SCM_BYTEVECTOR_CONTENTS (buf
) + offset
,
1503 (struct sockaddr
*) &addr
, &addr_size
));
1508 /* `recvfrom' does not necessarily return an address. Usually nothing
1509 is returned for stream sockets. */
1510 if (((struct sockaddr
*) &addr
)->sa_family
!= AF_UNSPEC
)
1511 address
= _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1513 address
= SCM_BOOL_F
;
1515 scm_remember_upto_here_1 (buf
);
1517 return scm_cons (scm_from_int (rv
), address
);
1521 SCM_DEFINE (scm_sendto
, "sendto", 3, 1, 1,
1522 (SCM sock
, SCM message
, SCM fam_or_sockaddr
, SCM address
, SCM args_and_flags
),
1523 "Transmit bytevector @var{message} on socket port\n"
1525 "destination address is specified using the @var{fam_or_sockaddr},\n"
1526 "@var{address} and\n"
1527 "@var{args_and_flags} arguments, or just a socket address object "
1528 "returned by @code{make-socket-address}, in a similar way to the\n"
1529 "@code{connect} procedure. @var{args_and_flags} contains\n"
1530 "the usual connection arguments optionally followed by\n"
1531 "a flags argument, which is a value or\n"
1532 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1533 "The value returned is the number of bytes transmitted --\n"
1534 "it's possible for\n"
1535 "this to be less than the length of @var{message} if the\n"
1537 "set to be non-blocking.\n"
1538 "Note that the data is written directly to the socket\n"
1539 "file descriptor:\n"
1540 "any unflushed buffered port data is ignored.\n"
1541 "This operation is defined only for strings containing codepoints\n"
1543 #define FUNC_NAME s_scm_sendto
1546 struct sockaddr
*soka
;
1549 sock
= SCM_COERCE_OUTPORT (sock
);
1550 SCM_VALIDATE_FPORT (1, sock
);
1551 fd
= SCM_FPORT_FDES (sock
);
1553 if (!scm_is_number (fam_or_sockaddr
))
1555 /* FAM_OR_SOCKADDR must actually be a `socket address' object. This
1556 means that the following arguments, i.e. ADDRESS and those listed in
1557 ARGS_AND_FLAGS, are the `MSG_' flags. */
1558 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
1559 if (!scm_is_eq (address
, SCM_UNDEFINED
))
1560 args_and_flags
= scm_cons (address
, args_and_flags
);
1563 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
1564 &args_and_flags
, 3, FUNC_NAME
, &size
);
1566 if (scm_is_null (args_and_flags
))
1570 SCM_VALIDATE_CONS (5, args_and_flags
);
1571 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
1574 SCM_VALIDATE_BYTEVECTOR (1, message
);
1576 SCM_SYSCALL (rv
= sendto (fd
,
1577 SCM_BYTEVECTOR_CONTENTS (message
),
1578 SCM_BYTEVECTOR_LENGTH (message
),
1583 int save_errno
= errno
;
1590 scm_remember_upto_here_1 (message
);
1591 return scm_from_int (rv
);
1600 /* protocol families. */
1602 scm_c_define ("AF_UNSPEC", scm_from_int (AF_UNSPEC
));
1604 #if defined HAVE_UNIX_DOMAIN_SOCKETS && defined AF_UNIX
1605 scm_c_define ("AF_UNIX", scm_from_int (AF_UNIX
));
1608 scm_c_define ("AF_INET", scm_from_int (AF_INET
));
1611 scm_c_define ("AF_INET6", scm_from_int (AF_INET6
));
1615 scm_c_define ("PF_UNSPEC", scm_from_int (PF_UNSPEC
));
1618 scm_c_define ("PF_UNIX", scm_from_int (PF_UNIX
));
1621 scm_c_define ("PF_INET", scm_from_int (PF_INET
));
1624 scm_c_define ("PF_INET6", scm_from_int (PF_INET6
));
1627 /* standard addresses. */
1629 scm_c_define ("INADDR_ANY", scm_from_ulong (INADDR_ANY
));
1631 #ifdef INADDR_BROADCAST
1632 scm_c_define ("INADDR_BROADCAST", scm_from_ulong (INADDR_BROADCAST
));
1635 scm_c_define ("INADDR_NONE", scm_from_ulong (INADDR_NONE
));
1637 #ifdef INADDR_LOOPBACK
1638 scm_c_define ("INADDR_LOOPBACK", scm_from_ulong (INADDR_LOOPBACK
));
1643 SOCK_PACKET is deliberately omitted, the GNU/Linux socket(2) and
1644 packet(7) advise that it's obsolete and strongly deprecated. */
1647 scm_c_define ("SOCK_STREAM", scm_from_int (SOCK_STREAM
));
1650 scm_c_define ("SOCK_DGRAM", scm_from_int (SOCK_DGRAM
));
1652 #ifdef SOCK_SEQPACKET
1653 scm_c_define ("SOCK_SEQPACKET", scm_from_int (SOCK_SEQPACKET
));
1656 scm_c_define ("SOCK_RAW", scm_from_int (SOCK_RAW
));
1659 scm_c_define ("SOCK_RDM", scm_from_int (SOCK_RDM
));
1662 /* setsockopt level.
1664 SOL_IP, SOL_TCP and SOL_UDP are defined on gnu/linux, but not on for
1665 instance NetBSD. We define IPPROTOs because that's what the posix spec
1666 shows in its example at
1668 http://www.opengroup.org/onlinepubs/007904975/functions/getsockopt.html
1671 scm_c_define ("SOL_SOCKET", scm_from_int (SOL_SOCKET
));
1674 scm_c_define ("IPPROTO_IP", scm_from_int (IPPROTO_IP
));
1677 scm_c_define ("IPPROTO_TCP", scm_from_int (IPPROTO_TCP
));
1680 scm_c_define ("IPPROTO_UDP", scm_from_int (IPPROTO_UDP
));
1683 /* setsockopt names. */
1685 scm_c_define ("SO_DEBUG", scm_from_int (SO_DEBUG
));
1688 scm_c_define ("SO_REUSEADDR", scm_from_int (SO_REUSEADDR
));
1691 scm_c_define ("SO_STYLE", scm_from_int (SO_STYLE
));
1694 scm_c_define ("SO_TYPE", scm_from_int (SO_TYPE
));
1697 scm_c_define ("SO_ERROR", scm_from_int (SO_ERROR
));
1700 scm_c_define ("SO_DONTROUTE", scm_from_int (SO_DONTROUTE
));
1703 scm_c_define ("SO_BROADCAST", scm_from_int (SO_BROADCAST
));
1706 scm_c_define ("SO_SNDBUF", scm_from_int (SO_SNDBUF
));
1709 scm_c_define ("SO_RCVBUF", scm_from_int (SO_RCVBUF
));
1712 scm_c_define ("SO_KEEPALIVE", scm_from_int (SO_KEEPALIVE
));
1715 scm_c_define ("SO_OOBINLINE", scm_from_int (SO_OOBINLINE
));
1718 scm_c_define ("SO_NO_CHECK", scm_from_int (SO_NO_CHECK
));
1721 scm_c_define ("SO_PRIORITY", scm_from_int (SO_PRIORITY
));
1724 scm_c_define ("SO_LINGER", scm_from_int (SO_LINGER
));
1726 #ifdef SO_REUSEPORT /* new in Linux 3.9 */
1727 scm_c_define ("SO_REUSEPORT", scm_from_int (SO_REUSEPORT
));
1730 /* recv/send options. */
1732 scm_c_define ("MSG_DONTWAIT", scm_from_int (MSG_DONTWAIT
));
1735 scm_c_define ("MSG_OOB", scm_from_int (MSG_OOB
));
1738 scm_c_define ("MSG_PEEK", scm_from_int (MSG_PEEK
));
1740 #ifdef MSG_DONTROUTE
1741 scm_c_define ("MSG_DONTROUTE", scm_from_int (MSG_DONTROUTE
));
1744 #ifdef IP_ADD_MEMBERSHIP
1745 scm_c_define ("IP_ADD_MEMBERSHIP", scm_from_int (IP_ADD_MEMBERSHIP
));
1746 scm_c_define ("IP_DROP_MEMBERSHIP", scm_from_int (IP_DROP_MEMBERSHIP
));
1749 #ifdef IP_MULTICAST_TTL
1750 scm_c_define ("IP_MULTICAST_TTL", scm_from_int ( IP_MULTICAST_TTL
));
1753 #ifdef IP_MULTICAST_IF
1754 scm_c_define ("IP_MULTICAST_IF", scm_from_int ( IP_MULTICAST_IF
));
1757 scm_add_feature ("socket");
1759 #include "libguile/socket.x"