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
37 #include <sys/types.h>
38 #include <sys/socket.h>
39 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
42 #include <netinet/in.h>
44 #include <arpa/inet.h>
48 #include "libguile/_scm.h"
49 #include "libguile/arrays.h"
50 #include "libguile/feature.h"
51 #include "libguile/fports.h"
52 #include "libguile/strings.h"
53 #include "libguile/vectors.h"
54 #include "libguile/dynwind.h"
55 #include "libguile/srfi-13.h"
57 #include "libguile/validate.h"
58 #include "libguile/socket.h"
60 #if SCM_ENABLE_DEPRECATED == 1
61 # include "libguile/deprecation.h"
66 #if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
67 #define SUN_LEN(ptr) (offsetof (struct sockaddr_un, sun_path) \
68 + strlen ((ptr)->sun_path))
71 /* The largest possible socket address. Wrapping it in a union guarantees
72 that the compiler will make it suitably aligned. */
75 struct sockaddr sockaddr
;
76 struct sockaddr_in sockaddr_in
;
78 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
79 struct sockaddr_un sockaddr_un
;
82 struct sockaddr_in6 sockaddr_in6
;
87 /* Maximum size of a socket address. */
88 #define MAX_ADDR_SIZE (sizeof (scm_t_max_sockaddr))
93 #ifdef HAVE_INET_NETOF
94 SCM_DEFINE (scm_inet_netof
, "inet-netof", 1, 0, 0,
96 "Return the network number part of the given IPv4\n"
97 "Internet address. E.g.,\n\n"
99 "(inet-netof 2130706433) @result{} 127\n"
101 #define FUNC_NAME s_scm_inet_netof
104 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
105 return scm_from_ulong (inet_netof (addr
));
110 #ifdef HAVE_INET_LNAOF
111 SCM_DEFINE (scm_lnaof
, "inet-lnaof", 1, 0, 0,
113 "Return the local-address-with-network part of the given\n"
114 "IPv4 Internet address, using the obsolete class A/B/C system.\n"
117 "(inet-lnaof 2130706433) @result{} 1\n"
119 #define FUNC_NAME s_scm_lnaof
122 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
123 return scm_from_ulong (inet_lnaof (addr
));
128 #ifdef HAVE_INET_MAKEADDR
129 SCM_DEFINE (scm_inet_makeaddr
, "inet-makeaddr", 2, 0, 0,
131 "Make an IPv4 Internet address by combining the network number\n"
132 "@var{net} with the local-address-within-network number\n"
133 "@var{lna}. E.g.,\n\n"
135 "(inet-makeaddr 127 1) @result{} 2130706433\n"
137 #define FUNC_NAME s_scm_inet_makeaddr
140 unsigned long netnum
;
141 unsigned long lnanum
;
143 netnum
= SCM_NUM2ULONG (1, net
);
144 lnanum
= SCM_NUM2ULONG (2, lna
);
145 addr
= inet_makeaddr (netnum
, lnanum
);
146 return scm_from_ulong (ntohl (addr
.s_addr
));
153 /* flip a 128 bit IPv6 address between host and network order. */
154 #ifdef WORDS_BIGENDIAN
155 #define FLIP_NET_HOST_128(addr)
157 #define FLIP_NET_HOST_128(addr)\
161 for (i = 0; i < 8; i++)\
163 scm_t_uint8 c = (addr)[i];\
165 (addr)[i] = (addr)[15 - i];\
171 #ifdef WORDS_BIGENDIAN
172 #define FLIPCPY_NET_HOST_128(dest, src) memcpy (dest, src, 16)
174 #define FLIPCPY_NET_HOST_128(dest, src) \
176 const scm_t_uint8 *tmp_srcp = (src) + 15; \
177 scm_t_uint8 *tmp_destp = (dest); \
180 *tmp_destp++ = *tmp_srcp--; \
181 } while (tmp_srcp != (src)); \
186 #if (SIZEOF_SCM_T_BITS * SCM_CHAR_BIT) > 128
187 #error "Assumption that scm_t_bits <= 128 bits has been violated."
190 #if (SIZEOF_UNSIGNED_LONG * SCM_CHAR_BIT) > 128
191 #error "Assumption that unsigned long <= 128 bits has been violated."
194 #if (SIZEOF_UNSIGNED_LONG_LONG * SCM_CHAR_BIT) > 128
195 #error "Assumption that unsigned long long <= 128 bits has been violated."
198 /* convert a 128 bit IPv6 address in network order to a host ordered
201 scm_from_ipv6 (const scm_t_uint8
*src
)
203 SCM result
= scm_i_mkbig ();
204 mpz_import (SCM_I_BIG_MPZ (result
),
206 1, /* big-endian chunk ordering */
207 16, /* chunks are 16 bytes long */
208 1, /* big-endian byte ordering */
209 0, /* "nails" -- leading unused bits per chunk */
211 return scm_i_normbig (result
);
214 /* convert a host ordered SCM integer to a 128 bit IPv6 address in
217 scm_to_ipv6 (scm_t_uint8 dst
[16], SCM src
)
219 if (SCM_I_INUMP (src
))
221 scm_t_signed_bits n
= SCM_I_INUM (src
);
223 scm_out_of_range (NULL
, src
);
224 #ifdef WORDS_BIGENDIAN
225 memset (dst
, 0, 16 - sizeof (scm_t_signed_bits
));
226 memcpy (dst
+ (16 - sizeof (scm_t_signed_bits
)),
228 sizeof (scm_t_signed_bits
));
230 memset (dst
+ sizeof (scm_t_signed_bits
),
232 16 - sizeof (scm_t_signed_bits
));
233 /* FIXME: this pair of ops is kinda wasteful -- should rewrite as
234 a single loop perhaps, similar to the handling of bignums. */
235 memcpy (dst
, &n
, sizeof (scm_t_signed_bits
));
236 FLIP_NET_HOST_128 (dst
);
239 else if (SCM_BIGP (src
))
243 if ((mpz_sgn (SCM_I_BIG_MPZ (src
)) < 0)
244 || mpz_sizeinbase (SCM_I_BIG_MPZ (src
), 2) > 128)
245 scm_out_of_range (NULL
, src
);
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 SCM_I_BIG_MPZ (src
));
255 scm_remember_upto_here_1 (src
);
258 scm_wrong_type_arg_msg ("scm_to_ipv6", 0, src
, "integer");
261 #endif /* HAVE_IPV6 */
265 SCM_DEFINE (scm_inet_ntop
, "inet-ntop", 2, 0, 0,
266 (SCM family
, SCM address
),
267 "Convert a network address into a printable string.\n"
268 "Note that unlike the C version of this function,\n"
269 "the input is an integer with normal host byte ordering.\n"
270 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
272 "(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
273 "(inet-ntop AF_INET6 (- (expt 2 128) 1))\n"
274 " @result{} \"ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\"\n"
276 #define FUNC_NAME s_scm_inet_ntop
279 #ifdef INET6_ADDRSTRLEN
280 char dst
[INET6_ADDRSTRLEN
];
286 af
= scm_to_int (family
);
287 SCM_ASSERT_RANGE (1, family
,
297 addr4
= htonl (SCM_NUM2ULONG (2, address
));
298 result
= inet_ntop (af
, &addr4
, dst
, sizeof (dst
));
301 else if (af
== AF_INET6
)
305 scm_to_ipv6 ((scm_t_uint8
*) addr6
, address
);
306 result
= inet_ntop (af
, &addr6
, dst
, sizeof (dst
));
310 SCM_MISC_ERROR ("unsupported address family", family
);
315 return scm_from_locale_string (dst
);
319 SCM_DEFINE (scm_inet_pton
, "inet-pton", 2, 0, 0,
320 (SCM family
, SCM address
),
321 "Convert a string containing a printable network address to\n"
322 "an integer address. Note that unlike the C version of this\n"
324 "the result is an integer with normal host byte ordering.\n"
325 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
327 "(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
328 "(inet-pton AF_INET6 \"::1\") @result{} 1\n"
330 #define FUNC_NAME s_scm_inet_pton
337 af
= scm_to_int (family
);
338 SCM_ASSERT_RANGE (1, family
,
345 src
= scm_to_locale_string (address
);
346 rv
= inet_pton (af
, src
, dst
);
354 SCM_MISC_ERROR ("Bad address", SCM_EOL
);
356 return scm_from_ulong (ntohl (*dst
));
358 else if (af
== AF_INET6
)
359 return scm_from_ipv6 ((scm_t_uint8
*) dst
);
362 SCM_MISC_ERROR ("unsupported address family", family
);
367 SCM_SYMBOL (sym_socket
, "socket");
369 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
371 SCM_DEFINE (scm_socket
, "socket", 3, 0, 0,
372 (SCM family
, SCM style
, SCM proto
),
373 "Return a new socket port of the type specified by @var{family},\n"
374 "@var{style} and @var{proto}. All three parameters are\n"
375 "integers. Supported values for @var{family} are\n"
376 "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
377 "Typical values for @var{style} are @code{SOCK_STREAM},\n"
378 "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
379 "@var{proto} can be obtained from a protocol name using\n"
380 "@code{getprotobyname}. A value of zero specifies the default\n"
381 "protocol, which is usually right.\n\n"
382 "A single socket port cannot by used for communication until it\n"
383 "has been connected to another socket.")
384 #define FUNC_NAME s_scm_socket
388 fd
= socket (scm_to_int (family
),
393 return SCM_SOCK_FD_TO_PORT (fd
);
397 #ifdef HAVE_SOCKETPAIR
398 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
399 (SCM family
, SCM style
, SCM proto
),
400 "Return a pair of connected (but unnamed) socket ports of the\n"
401 "type specified by @var{family}, @var{style} and @var{proto}.\n"
402 "Many systems support only socket pairs of the @code{AF_UNIX}\n"
403 "family. Zero is likely to be the only meaningful value for\n"
405 #define FUNC_NAME s_scm_socketpair
410 fam
= scm_to_int (family
);
412 if (socketpair (fam
, scm_to_int (style
), scm_to_int (proto
), fd
) == -1)
415 return scm_cons (SCM_SOCK_FD_TO_PORT (fd
[0]), SCM_SOCK_FD_TO_PORT (fd
[1]));
420 /* Possible results for `getsockopt ()'. Wrapping it into a union guarantees
421 suitable alignment. */
424 #ifdef HAVE_STRUCT_LINGER
425 struct linger linger
;
429 } scm_t_getsockopt_result
;
431 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
432 (SCM sock
, SCM level
, SCM optname
),
433 "Return an option value from socket port @var{sock}.\n"
435 "@var{level} is an integer specifying a protocol layer, either\n"
436 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
437 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
438 "(@pxref{Network Databases}).\n"
440 "@defvar SOL_SOCKET\n"
441 "@defvarx IPPROTO_IP\n"
442 "@defvarx IPPROTO_TCP\n"
443 "@defvarx IPPROTO_UDP\n"
446 "@var{optname} is an integer specifying an option within the\n"
449 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
450 "defined (when provided by the system). For their meaning see\n"
451 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
452 "Manual}, or @command{man 7 socket}.\n"
455 "@defvarx SO_REUSEADDR\n"
456 "@defvarx SO_STYLE\n"
458 "@defvarx SO_ERROR\n"
459 "@defvarx SO_DONTROUTE\n"
460 "@defvarx SO_BROADCAST\n"
461 "@defvarx SO_SNDBUF\n"
462 "@defvarx SO_RCVBUF\n"
463 "@defvarx SO_KEEPALIVE\n"
464 "@defvarx SO_OOBINLINE\n"
465 "@defvarx SO_NO_CHECK\n"
466 "@defvarx SO_PRIORITY\n"
467 "@defvarx SO_REUSEPORT\n"
468 "The value returned is an integer.\n"
471 "@defvar SO_LINGER\n"
472 "The value returned is a pair of integers\n"
473 "@code{(@var{enable} . @var{timeout})}. On old systems without\n"
474 "timeout support (ie.@: without @code{struct linger}), only\n"
475 "@var{enable} has an effect but the value in Guile is always a\n"
478 #define FUNC_NAME s_scm_getsockopt
481 /* size of optval is the largest supported option. */
482 scm_t_getsockopt_result optval
;
483 socklen_t optlen
= sizeof (optval
);
487 sock
= SCM_COERCE_OUTPORT (sock
);
488 SCM_VALIDATE_OPFPORT (1, sock
);
489 ilevel
= scm_to_int (level
);
490 ioptname
= scm_to_int (optname
);
492 fd
= SCM_FPORT_FDES (sock
);
493 if (getsockopt (fd
, ilevel
, ioptname
, (void *) &optval
, &optlen
) == -1)
496 if (ilevel
== SOL_SOCKET
)
499 if (ioptname
== SO_LINGER
)
501 #ifdef HAVE_STRUCT_LINGER
502 struct linger
*ling
= (struct linger
*) &optval
;
504 return scm_cons (scm_from_long (ling
->l_onoff
),
505 scm_from_long (ling
->l_linger
));
507 return scm_cons (scm_from_long (*(int *) &optval
),
515 || ioptname
== SO_SNDBUF
518 || ioptname
== SO_RCVBUF
522 return scm_from_size_t (*(size_t *) &optval
);
525 return scm_from_int (*(int *) &optval
);
529 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
530 (SCM sock
, SCM level
, SCM optname
, SCM value
),
531 "Set an option on socket port @var{sock}. The return value is\n"
534 "@var{level} is an integer specifying a protocol layer, either\n"
535 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
536 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
537 "(@pxref{Network Databases}).\n"
539 "@defvar SOL_SOCKET\n"
540 "@defvarx IPPROTO_IP\n"
541 "@defvarx IPPROTO_TCP\n"
542 "@defvarx IPPROTO_UDP\n"
545 "@var{optname} is an integer specifying an option within the\n"
548 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
549 "defined (when provided by the system). For their meaning see\n"
550 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
551 "Manual}, or @command{man 7 socket}.\n"
554 "@defvarx SO_REUSEADDR\n"
555 "@defvarx SO_STYLE\n"
557 "@defvarx SO_ERROR\n"
558 "@defvarx SO_DONTROUTE\n"
559 "@defvarx SO_BROADCAST\n"
560 "@defvarx SO_SNDBUF\n"
561 "@defvarx SO_RCVBUF\n"
562 "@defvarx SO_KEEPALIVE\n"
563 "@defvarx SO_OOBINLINE\n"
564 "@defvarx SO_NO_CHECK\n"
565 "@defvarx SO_PRIORITY\n"
566 "@defvarx SO_REUSEPORT\n"
567 "@var{value} is an integer.\n"
570 "@defvar SO_LINGER\n"
571 "@var{value} is a pair of integers @code{(@var{ENABLE}\n"
572 ". @var{TIMEOUT})}. On old systems without timeout support\n"
573 "(ie.@: without @code{struct linger}), only @var{ENABLE} has an\n"
574 "effect but the value in Guile is always a pair.\n"
577 "@c Note that we refer only to ``man ip'' here. On GNU/Linux it's\n"
578 "@c ``man 7 ip'' but on NetBSD it's ``man 4 ip''.\n"
580 "For IP level (@code{IPPROTO_IP}) the following @var{optname}s\n"
581 "are defined (when provided by the system). See @command{man\n"
582 "ip} for what they mean.\n"
584 "@defvar IP_MULTICAST_IF\n"
585 "This sets the source interface used by multicast traffic.\n"
588 "@defvar IP_MULTICAST_TTL\n"
589 "This sets the default TTL for multicast traffic. This defaults \n"
590 "to 1 and should be increased to allow traffic to pass beyond the\n"
594 "@defvar IP_ADD_MEMBERSHIP\n"
595 "@defvarx IP_DROP_MEMBERSHIP\n"
596 "These can be used only with @code{setsockopt}, not\n"
597 "@code{getsockopt}. @var{value} is a pair\n"
598 "@code{(@var{MULTIADDR} . @var{INTERFACEADDR})} of IPv4\n"
599 "addresses (@pxref{Network Address Conversion}).\n"
600 "@var{MULTIADDR} is a multicast address to be added to or\n"
601 "dropped from the interface @var{INTERFACEADDR}.\n"
602 "@var{INTERFACEADDR} can be @code{INADDR_ANY} to have the system\n"
603 "select the interface. @var{INTERFACEADDR} can also be an\n"
604 "interface index number, on systems supporting that.\n"
606 #define FUNC_NAME s_scm_setsockopt
611 #ifdef HAVE_STRUCT_LINGER
612 struct linger opt_linger
;
615 #ifdef HAVE_STRUCT_IP_MREQ
616 struct ip_mreq opt_mreq
;
619 const void *optval
= NULL
;
620 socklen_t optlen
= 0;
622 int ilevel
, ioptname
;
624 sock
= SCM_COERCE_OUTPORT (sock
);
626 SCM_VALIDATE_OPFPORT (1, sock
);
627 ilevel
= scm_to_int (level
);
628 ioptname
= scm_to_int (optname
);
630 fd
= SCM_FPORT_FDES (sock
);
632 if (ilevel
== SOL_SOCKET
)
635 if (ioptname
== SO_LINGER
)
637 #ifdef HAVE_STRUCT_LINGER
638 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
639 opt_linger
.l_onoff
= scm_to_int (SCM_CAR (value
));
640 opt_linger
.l_linger
= scm_to_int (SCM_CDR (value
));
641 optlen
= sizeof (struct linger
);
642 optval
= &opt_linger
;
644 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
645 opt_int
= scm_to_int (SCM_CAR (value
));
646 /* timeout is ignored, but may as well validate it. */
647 scm_to_int (SCM_CDR (value
));
648 optlen
= sizeof (int);
656 || ioptname
== SO_SNDBUF
659 || ioptname
== SO_RCVBUF
663 opt_int
= scm_to_int (value
);
664 optlen
= sizeof (size_t);
669 #ifdef HAVE_STRUCT_IP_MREQ
670 if (ilevel
== IPPROTO_IP
&&
671 (ioptname
== IP_ADD_MEMBERSHIP
|| ioptname
== IP_DROP_MEMBERSHIP
))
673 /* Fourth argument must be a pair of addresses. */
674 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
675 opt_mreq
.imr_multiaddr
.s_addr
= htonl (scm_to_ulong (SCM_CAR (value
)));
676 opt_mreq
.imr_interface
.s_addr
= htonl (scm_to_ulong (SCM_CDR (value
)));
677 optlen
= sizeof (opt_mreq
);
684 /* Most options take an int. */
685 opt_int
= scm_to_int (value
);
686 optlen
= sizeof (int);
690 if (setsockopt (fd
, ilevel
, ioptname
, optval
, optlen
) == -1)
692 return SCM_UNSPECIFIED
;
696 /* Our documentation hard-codes this mapping, so make sure it holds. */
697 verify (SHUT_RD
== 0);
698 verify (SHUT_WR
== 1);
699 verify (SHUT_RDWR
== 2);
701 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
703 "Sockets can be closed simply by using @code{close-port}. The\n"
704 "@code{shutdown} procedure allows reception or transmission on a\n"
705 "connection to be shut down individually, according to the parameter\n"
709 "Stop receiving data for this socket. If further data arrives, reject it.\n"
711 "Stop trying to transmit data from this socket. Discard any\n"
712 "data waiting to be sent. Stop looking for acknowledgement of\n"
713 "data already sent; don't retransmit it if it is lost.\n"
715 "Stop both reception and transmission.\n"
717 "The return value is unspecified.")
718 #define FUNC_NAME s_scm_shutdown
721 sock
= SCM_COERCE_OUTPORT (sock
);
722 SCM_VALIDATE_OPFPORT (1, sock
);
723 fd
= SCM_FPORT_FDES (sock
);
724 if (shutdown (fd
, scm_to_signed_integer (how
, 0, 2)) == -1)
726 return SCM_UNSPECIFIED
;
730 /* convert fam/address/args into a sockaddr of the appropriate type.
731 args is modified by removing the arguments actually used.
732 which_arg and proc are used when reporting errors:
733 which_arg is the position of address in the original argument list.
734 proc is the name of the original procedure.
735 size returns the size of the structure allocated. */
737 static struct sockaddr
*
738 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
739 const char *proc
, size_t *size
)
740 #define FUNC_NAME proc
746 struct sockaddr_in
*soka
;
750 SCM_VALIDATE_ULONG_COPY (which_arg
, address
, addr
);
751 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
752 port
= scm_to_int (SCM_CAR (*args
));
753 *args
= SCM_CDR (*args
);
754 soka
= (struct sockaddr_in
*) scm_malloc (sizeof (struct sockaddr_in
));
755 memset (soka
, '\0', sizeof (struct sockaddr_in
));
757 #ifdef HAVE_STRUCT_SOCKADDR_IN_SIN_LEN
758 soka
->sin_len
= sizeof (struct sockaddr_in
);
760 soka
->sin_family
= AF_INET
;
761 soka
->sin_addr
.s_addr
= htonl (addr
);
762 soka
->sin_port
= htons (port
);
763 *size
= sizeof (struct sockaddr_in
);
764 return (struct sockaddr
*) soka
;
771 struct sockaddr_in6
*soka
;
772 unsigned long flowinfo
= 0;
773 unsigned long scope_id
= 0;
775 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
776 port
= scm_to_int (SCM_CAR (*args
));
777 *args
= SCM_CDR (*args
);
778 if (scm_is_pair (*args
))
780 SCM_VALIDATE_ULONG_COPY (which_arg
+ 2, SCM_CAR (*args
), flowinfo
);
781 *args
= SCM_CDR (*args
);
782 if (scm_is_pair (*args
))
784 SCM_VALIDATE_ULONG_COPY (which_arg
+ 3, SCM_CAR (*args
),
786 *args
= SCM_CDR (*args
);
789 soka
= (struct sockaddr_in6
*) scm_malloc (sizeof (struct sockaddr_in6
));
791 #ifdef HAVE_STRUCT_SOCKADDR_IN6_SIN6_LEN
792 soka
->sin6_len
= sizeof (struct sockaddr_in6
);
794 soka
->sin6_family
= AF_INET6
;
795 scm_to_ipv6 (soka
->sin6_addr
.s6_addr
, address
);
796 soka
->sin6_port
= htons (port
);
797 soka
->sin6_flowinfo
= flowinfo
;
798 #ifdef HAVE_SIN6_SCOPE_ID
799 soka
->sin6_scope_id
= scope_id
;
801 *size
= sizeof (struct sockaddr_in6
);
802 return (struct sockaddr
*) soka
;
805 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
808 struct sockaddr_un
*soka
;
812 scm_dynwind_begin (0);
814 c_address
= scm_to_locale_string (address
);
815 scm_dynwind_free (c_address
);
817 /* the static buffer size in sockaddr_un seems to be arbitrary
818 and not necessarily a hard limit. e.g., the glibc manual
819 suggests it may be possible to declare it size 0. let's
820 ignore it. if the O/S doesn't like the size it will cause
821 connect/bind etc., to fail. sun_path is always the last
822 member of the structure. */
823 addr_size
= sizeof (struct sockaddr_un
)
824 + max (0, strlen (c_address
) + 1 - (sizeof soka
->sun_path
));
825 soka
= (struct sockaddr_un
*) scm_malloc (addr_size
);
826 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
827 soka
->sun_family
= AF_UNIX
;
828 strcpy (soka
->sun_path
, c_address
);
829 *size
= SUN_LEN (soka
);
832 return (struct sockaddr
*) soka
;
836 scm_out_of_range (proc
, scm_from_int (fam
));
841 SCM_DEFINE (scm_connect
, "connect", 2, 1, 1,
842 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
843 "Initiate a connection from a socket using a specified address\n"
844 "family to the address\n"
845 "specified by @var{address} and possibly @var{args}.\n"
846 "The format required for @var{address}\n"
847 "and @var{args} depends on the family of the socket.\n\n"
848 "For a socket of family @code{AF_UNIX},\n"
849 "only @var{address} is specified and must be a string with the\n"
850 "filename where the socket is to be created.\n\n"
851 "For a socket of family @code{AF_INET},\n"
852 "@var{address} must be an integer IPv4 host address and\n"
853 "@var{args} must be a single integer port number.\n\n"
854 "For a socket of family @code{AF_INET6},\n"
855 "@var{address} must be an integer IPv6 host address and\n"
856 "@var{args} may be up to three integers:\n"
857 "port [flowinfo] [scope_id],\n"
858 "where flowinfo and scope_id default to zero.\n\n"
859 "Alternatively, the second argument can be a socket address object "
860 "as returned by @code{make-socket-address}, in which case the "
861 "no additional arguments should be passed.\n\n"
862 "The return value is unspecified.")
863 #define FUNC_NAME s_scm_connect
866 struct sockaddr
*soka
;
869 sock
= SCM_COERCE_OUTPORT (sock
);
870 SCM_VALIDATE_OPFPORT (1, sock
);
871 fd
= SCM_FPORT_FDES (sock
);
873 if (scm_is_eq (address
, SCM_UNDEFINED
))
874 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
875 `socket address' object. */
876 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
878 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
879 &args
, 3, FUNC_NAME
, &size
);
881 if (connect (fd
, soka
, size
) == -1)
883 int save_errno
= errno
;
890 return SCM_UNSPECIFIED
;
894 SCM_DEFINE (scm_bind
, "bind", 2, 1, 1,
895 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
896 "Assign an address to the socket port @var{sock}.\n"
897 "Generally this only needs to be done for server sockets,\n"
898 "so they know where to look for incoming connections. A socket\n"
899 "without an address will be assigned one automatically when it\n"
900 "starts communicating.\n\n"
901 "The format of @var{address} and @var{args} depends\n"
902 "on the family of the socket.\n\n"
903 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
904 "is specified and must be a string with the filename where\n"
905 "the socket is to be created.\n\n"
906 "For a socket of family @code{AF_INET}, @var{address}\n"
907 "must be an integer IPv4 address and @var{args}\n"
908 "must be a single integer port number.\n\n"
909 "The values of the following variables can also be used for\n"
911 "@defvar INADDR_ANY\n"
912 "Allow connections from any address.\n"
914 "@defvar INADDR_LOOPBACK\n"
915 "The address of the local host using the loopback device.\n"
917 "@defvar INADDR_BROADCAST\n"
918 "The broadcast address on the local network.\n"
920 "@defvar INADDR_NONE\n"
923 "For a socket of family @code{AF_INET6}, @var{address}\n"
924 "must be an integer IPv6 address and @var{args}\n"
925 "may be up to three integers:\n"
926 "port [flowinfo] [scope_id],\n"
927 "where flowinfo and scope_id default to zero.\n\n"
928 "Alternatively, the second argument can be a socket address object "
929 "as returned by @code{make-socket-address}, in which case the "
930 "no additional arguments should be passed.\n\n"
931 "The return value is unspecified.")
932 #define FUNC_NAME s_scm_bind
934 struct sockaddr
*soka
;
938 sock
= SCM_COERCE_OUTPORT (sock
);
939 SCM_VALIDATE_OPFPORT (1, sock
);
940 fd
= SCM_FPORT_FDES (sock
);
942 if (scm_is_eq (address
, SCM_UNDEFINED
))
943 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
944 `socket address' object. */
945 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
947 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
948 &args
, 3, FUNC_NAME
, &size
);
951 if (bind (fd
, soka
, size
) == -1)
953 int save_errno
= errno
;
960 return SCM_UNSPECIFIED
;
964 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
965 (SCM sock
, SCM backlog
),
966 "Enable @var{sock} to accept connection\n"
967 "requests. @var{backlog} is an integer specifying\n"
968 "the maximum length of the queue for pending connections.\n"
969 "If the queue fills, new clients will fail to connect until\n"
970 "the server calls @code{accept} to accept a connection from\n"
972 "The return value is unspecified.")
973 #define FUNC_NAME s_scm_listen
976 sock
= SCM_COERCE_OUTPORT (sock
);
977 SCM_VALIDATE_OPFPORT (1, sock
);
978 fd
= SCM_FPORT_FDES (sock
);
979 if (listen (fd
, scm_to_int (backlog
)) == -1)
981 return SCM_UNSPECIFIED
;
985 /* Put the components of a sockaddr into a new SCM vector. */
986 static SCM_C_INLINE_KEYWORD SCM
987 _scm_from_sockaddr (const scm_t_max_sockaddr
*address
, unsigned addr_size
,
990 SCM result
= SCM_EOL
;
991 short int fam
= ((struct sockaddr
*) address
)->sa_family
;
997 const struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
999 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
1001 SCM_SIMPLE_VECTOR_SET(result
, 0,
1002 scm_from_short (fam
));
1003 SCM_SIMPLE_VECTOR_SET(result
, 1,
1004 scm_from_ulong (ntohl (nad
->sin_addr
.s_addr
)));
1005 SCM_SIMPLE_VECTOR_SET(result
, 2,
1006 scm_from_ushort (ntohs (nad
->sin_port
)));
1012 const struct sockaddr_in6
*nad
= (struct sockaddr_in6
*) address
;
1014 result
= scm_c_make_vector (5, SCM_UNSPECIFIED
);
1015 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1016 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_ipv6 (nad
->sin6_addr
.s6_addr
));
1017 SCM_SIMPLE_VECTOR_SET(result
, 2, scm_from_ushort (ntohs (nad
->sin6_port
)));
1018 SCM_SIMPLE_VECTOR_SET(result
, 3, scm_from_uint32 (nad
->sin6_flowinfo
));
1019 #ifdef HAVE_SIN6_SCOPE_ID
1020 SCM_SIMPLE_VECTOR_SET(result
, 4, scm_from_ulong (nad
->sin6_scope_id
));
1022 SCM_SIMPLE_VECTOR_SET(result
, 4, SCM_INUM0
);
1027 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1030 const struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
1032 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
1034 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1035 /* When addr_size is not enough to cover sun_path, do not try
1037 if (addr_size
<= offsetof (struct sockaddr_un
, sun_path
))
1038 SCM_SIMPLE_VECTOR_SET(result
, 1, SCM_BOOL_F
);
1040 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_locale_string (nad
->sun_path
));
1045 result
= SCM_UNSPECIFIED
;
1046 scm_misc_error (proc
, "unrecognised address family: ~A",
1047 scm_list_1 (scm_from_int (fam
)));
1053 /* The publicly-visible function. Return a Scheme object representing
1054 ADDRESS, an address of ADDR_SIZE bytes. */
1056 scm_from_sockaddr (const struct sockaddr
*address
, unsigned addr_size
)
1058 return (_scm_from_sockaddr ((scm_t_max_sockaddr
*) address
,
1059 addr_size
, "scm_from_sockaddr"));
1062 /* Convert ADDRESS, an address object returned by either
1063 `scm_from_sockaddr ()' or `scm_make_socket_address ()', into its C
1064 representation. On success, a non-NULL pointer is returned and
1065 ADDRESS_SIZE is updated to the actual size (in bytes) of the returned
1066 address. The result must eventually be freed using `free ()'. */
1068 scm_to_sockaddr (SCM address
, size_t *address_size
)
1069 #define FUNC_NAME "scm_to_sockaddr"
1072 struct sockaddr
*c_address
= NULL
;
1074 SCM_VALIDATE_VECTOR (1, address
);
1077 family
= scm_to_short (SCM_SIMPLE_VECTOR_REF (address
, 0));
1083 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 3)
1084 scm_misc_error (FUNC_NAME
,
1085 "invalid inet address representation: ~A",
1086 scm_list_1 (address
));
1089 struct sockaddr_in c_inet
;
1091 memset (&c_inet
, '\0', sizeof (struct sockaddr_in
));
1093 #ifdef HAVE_STRUCT_SOCKADDR_IN_SIN_LEN
1094 c_inet
.sin_len
= sizeof (struct sockaddr_in
);
1097 c_inet
.sin_addr
.s_addr
=
1098 htonl (scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 1)));
1100 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1101 c_inet
.sin_family
= AF_INET
;
1103 *address_size
= sizeof (c_inet
);
1104 c_address
= scm_malloc (sizeof (c_inet
));
1105 memcpy (c_address
, &c_inet
, sizeof (c_inet
));
1114 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 5)
1115 scm_misc_error (FUNC_NAME
, "invalid inet6 address representation: ~A",
1116 scm_list_1 (address
));
1119 struct sockaddr_in6 c_inet6
;
1121 scm_to_ipv6 (c_inet6
.sin6_addr
.s6_addr
,
1122 SCM_SIMPLE_VECTOR_REF (address
, 1));
1124 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1125 c_inet6
.sin6_flowinfo
=
1126 scm_to_uint32 (SCM_SIMPLE_VECTOR_REF (address
, 3));
1127 #ifdef HAVE_SIN6_SCOPE_ID
1128 c_inet6
.sin6_scope_id
=
1129 scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 4));
1132 c_inet6
.sin6_family
= AF_INET6
;
1134 *address_size
= sizeof (c_inet6
);
1135 c_address
= scm_malloc (sizeof (c_inet6
));
1136 memcpy (c_address
, &c_inet6
, sizeof (c_inet6
));
1143 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1146 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 2)
1147 scm_misc_error (FUNC_NAME
, "invalid unix address representation: ~A",
1148 scm_list_1 (address
));
1152 size_t path_len
= 0;
1154 path
= SCM_SIMPLE_VECTOR_REF (address
, 1);
1155 if (!scm_is_string (path
) && !scm_is_false (path
))
1156 scm_misc_error (FUNC_NAME
, "invalid unix address "
1157 "path: ~A", scm_list_1 (path
));
1160 struct sockaddr_un c_unix
;
1162 if (scm_is_false (path
))
1165 path_len
= scm_c_string_length (path
);
1167 #ifdef UNIX_PATH_MAX
1168 if (path_len
>= UNIX_PATH_MAX
)
1170 /* We can hope that this limit will eventually vanish, at least on GNU.
1171 However, currently, while glibc doesn't define `UNIX_PATH_MAX', it
1172 documents it has being limited to 108 bytes. */
1173 if (path_len
>= sizeof (c_unix
.sun_path
))
1175 scm_misc_error (FUNC_NAME
, "unix address path "
1176 "too long: ~A", scm_list_1 (path
));
1181 scm_to_locale_stringbuf (path
, c_unix
.sun_path
,
1182 #ifdef UNIX_PATH_MAX
1185 sizeof (c_unix
.sun_path
));
1187 c_unix
.sun_path
[path_len
] = '\0';
1190 if (strlen (c_unix
.sun_path
) != path_len
)
1191 scm_misc_error (FUNC_NAME
, "unix address path "
1192 "contains nul characters: ~A",
1196 c_unix
.sun_path
[0] = '\0';
1198 c_unix
.sun_family
= AF_UNIX
;
1200 *address_size
= SUN_LEN (&c_unix
);
1201 c_address
= scm_malloc (sizeof (c_unix
));
1202 memcpy (c_address
, &c_unix
, sizeof (c_unix
));
1212 scm_misc_error (FUNC_NAME
, "unrecognised address family: ~A",
1213 scm_list_1 (scm_from_ushort (family
)));
1221 /* Return a newly-allocated `sockaddr' structure that reflects ADDRESS, being
1222 an address of family FAMILY, with the family-specific parameters ARGS (see
1223 the description of `connect' for details). The returned structure may be
1224 freed using `free ()'. */
1226 scm_c_make_socket_address (SCM family
, SCM address
, SCM args
,
1227 size_t *address_size
)
1229 struct sockaddr
*soka
;
1231 soka
= scm_fill_sockaddr (scm_to_ushort (family
), address
, &args
, 1,
1232 "scm_c_make_socket_address", address_size
);
1237 SCM_DEFINE (scm_make_socket_address
, "make-socket-address", 2, 0, 1,
1238 (SCM family
, SCM address
, SCM args
),
1239 "Return a Scheme address object that reflects @var{address}, "
1240 "being an address of family @var{family}, with the "
1241 "family-specific parameters @var{args} (see the description of "
1242 "@code{connect} for details).")
1243 #define FUNC_NAME s_scm_make_socket_address
1245 SCM result
= SCM_BOOL_F
;
1246 struct sockaddr
*c_address
;
1247 size_t c_address_size
;
1249 c_address
= scm_c_make_socket_address (family
, address
, args
,
1251 if (c_address
!= NULL
)
1253 result
= scm_from_sockaddr (c_address
, c_address_size
);
1262 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
1264 "Accept a connection on a bound, listening socket.\n"
1266 "are no pending connections in the queue, wait until\n"
1267 "one is available unless the non-blocking option has been\n"
1268 "set on the socket.\n\n"
1269 "The return value is a\n"
1270 "pair in which the @emph{car} is a new socket port for the\n"
1272 "the @emph{cdr} is an object with address information about the\n"
1273 "client which initiated the connection.\n\n"
1274 "@var{sock} does not become part of the\n"
1275 "connection and will continue to accept new requests.")
1276 #define FUNC_NAME s_scm_accept
1282 socklen_t addr_size
= MAX_ADDR_SIZE
;
1283 scm_t_max_sockaddr addr
;
1285 sock
= SCM_COERCE_OUTPORT (sock
);
1286 SCM_VALIDATE_OPFPORT (1, sock
);
1287 fd
= SCM_FPORT_FDES (sock
);
1288 SCM_SYSCALL (newfd
= accept (fd
, (struct sockaddr
*) &addr
, &addr_size
));
1291 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
1292 address
= _scm_from_sockaddr (&addr
, addr_size
,
1295 return scm_cons (newsock
, address
);
1299 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
1301 "Return the address of @var{sock}, in the same form as the\n"
1302 "object returned by @code{accept}. On many systems the address\n"
1303 "of a socket in the @code{AF_FILE} namespace cannot be read.")
1304 #define FUNC_NAME s_scm_getsockname
1307 socklen_t addr_size
= MAX_ADDR_SIZE
;
1308 scm_t_max_sockaddr addr
;
1310 sock
= SCM_COERCE_OUTPORT (sock
);
1311 SCM_VALIDATE_OPFPORT (1, sock
);
1312 fd
= SCM_FPORT_FDES (sock
);
1313 if (getsockname (fd
, (struct sockaddr
*) &addr
, &addr_size
) == -1)
1316 return _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1320 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
1322 "Return the address that @var{sock}\n"
1323 "is connected to, in the same form as the object returned by\n"
1324 "@code{accept}. On many systems the address of a socket in the\n"
1325 "@code{AF_FILE} namespace cannot be read.")
1326 #define FUNC_NAME s_scm_getpeername
1329 socklen_t addr_size
= MAX_ADDR_SIZE
;
1330 scm_t_max_sockaddr addr
;
1332 sock
= SCM_COERCE_OUTPORT (sock
);
1333 SCM_VALIDATE_OPFPORT (1, sock
);
1334 fd
= SCM_FPORT_FDES (sock
);
1335 if (getpeername (fd
, (struct sockaddr
*) &addr
, &addr_size
) == -1)
1338 return _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1342 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
1343 (SCM sock
, SCM buf
, SCM flags
),
1344 "Receive data from a socket port.\n"
1345 "@var{sock} must already\n"
1346 "be bound to the address from which data is to be received.\n"
1347 "@var{buf} is a bytevector into which\n"
1348 "the data will be written. The size of @var{buf} limits\n"
1350 "data which can be received: in the case of packet\n"
1351 "protocols, if a packet larger than this limit is encountered\n"
1353 "will be irrevocably lost.\n\n"
1354 "The optional @var{flags} argument is a value or\n"
1355 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1356 "The value returned is the number of bytes read from the\n"
1358 "Note that the data is read directly from the socket file\n"
1360 "any unread buffered port data is ignored.")
1361 #define FUNC_NAME s_scm_recv
1365 SCM_VALIDATE_OPFPORT (1, sock
);
1367 if (SCM_UNBNDP (flags
))
1370 flg
= scm_to_int (flags
);
1371 fd
= SCM_FPORT_FDES (sock
);
1373 SCM_VALIDATE_BYTEVECTOR (1, buf
);
1375 SCM_SYSCALL (rv
= recv (fd
,
1376 SCM_BYTEVECTOR_CONTENTS (buf
),
1377 SCM_BYTEVECTOR_LENGTH (buf
),
1380 if (SCM_UNLIKELY (rv
== -1))
1383 scm_remember_upto_here (buf
);
1384 return scm_from_int (rv
);
1388 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
1389 (SCM sock
, SCM message
, SCM flags
),
1390 "Transmit bytevector @var{message} on socket port @var{sock}.\n"
1391 "@var{sock} must already be bound to a destination address. The\n"
1392 "value returned is the number of bytes transmitted --\n"
1393 "it's possible for\n"
1394 "this to be less than the length of @var{message}\n"
1395 "if the socket is\n"
1396 "set to be non-blocking. The optional @var{flags} argument\n"
1398 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1399 "Note that the data is written directly to the socket\n"
1400 "file descriptor:\n"
1401 "any unflushed buffered port data is ignored.\n\n"
1402 "This operation is defined only for strings containing codepoints\n"
1404 #define FUNC_NAME s_scm_send
1408 sock
= SCM_COERCE_OUTPORT (sock
);
1409 SCM_VALIDATE_OPFPORT (1, sock
);
1411 if (SCM_UNBNDP (flags
))
1414 flg
= scm_to_int (flags
);
1416 fd
= SCM_FPORT_FDES (sock
);
1418 SCM_VALIDATE_BYTEVECTOR (1, message
);
1420 SCM_SYSCALL (rv
= send (fd
,
1421 SCM_BYTEVECTOR_CONTENTS (message
),
1422 SCM_BYTEVECTOR_LENGTH (message
),
1428 scm_remember_upto_here_1 (message
);
1429 return scm_from_int (rv
);
1433 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
1434 (SCM sock
, SCM buf
, SCM flags
, SCM start
, SCM end
),
1435 "Receive data from socket port @var{sock} (which must be already\n"
1436 "bound), returning the originating address as well as the data.\n"
1437 "This is usually for use on datagram sockets, but can be used on\n"
1438 "stream-oriented sockets too.\n"
1440 "The data received is stored in bytevector @var{buf}, using\n"
1441 "either the whole bytevector or just the region between the optional\n"
1442 "@var{start} and @var{end} positions. The size of @var{buf}\n"
1443 "limits the amount of data that can be received. For datagram\n"
1444 "protocols, if a packet larger than this is received then excess\n"
1445 "bytes are irrevocably lost.\n"
1447 "The return value is a pair. The @code{car} is the number of\n"
1448 "bytes read. The @code{cdr} is a socket address object which is\n"
1449 "where the data came from, or @code{#f} if the origin is\n"
1452 "The optional @var{flags} argument is a or bitwise OR\n"
1453 "(@code{logior}) of @code{MSG_OOB}, @code{MSG_PEEK},\n"
1454 "@code{MSG_DONTROUTE} etc.\n"
1456 "Data is read directly from the socket file descriptor, any\n"
1457 "buffered port data is ignored.\n"
1459 "On a GNU/Linux system @code{recvfrom!} is not multi-threading,\n"
1460 "all threads stop while a @code{recvfrom!} call is in progress.\n"
1461 "An application may need to use @code{select}, @code{O_NONBLOCK}\n"
1462 "or @code{MSG_DONTWAIT} to avoid this.")
1463 #define FUNC_NAME s_scm_recvfrom
1467 size_t offset
, cend
;
1468 socklen_t addr_size
= MAX_ADDR_SIZE
;
1469 scm_t_max_sockaddr addr
;
1471 SCM_VALIDATE_OPFPORT (1, sock
);
1472 fd
= SCM_FPORT_FDES (sock
);
1474 if (SCM_UNBNDP (flags
))
1477 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
1479 ((struct sockaddr
*) &addr
)->sa_family
= AF_UNSPEC
;
1481 SCM_VALIDATE_BYTEVECTOR (1, buf
);
1483 if (SCM_UNBNDP (start
))
1486 offset
= scm_to_size_t (start
);
1488 if (SCM_UNBNDP (end
))
1489 cend
= SCM_BYTEVECTOR_LENGTH (buf
);
1492 cend
= scm_to_size_t (end
);
1493 if (SCM_UNLIKELY (cend
>= SCM_BYTEVECTOR_LENGTH (buf
)
1495 scm_out_of_range (FUNC_NAME
, end
);
1498 SCM_SYSCALL (rv
= recvfrom (fd
,
1499 SCM_BYTEVECTOR_CONTENTS (buf
) + offset
,
1501 (struct sockaddr
*) &addr
, &addr_size
));
1506 /* `recvfrom' does not necessarily return an address. Usually nothing
1507 is returned for stream sockets. */
1508 if (((struct sockaddr
*) &addr
)->sa_family
!= AF_UNSPEC
)
1509 address
= _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1511 address
= SCM_BOOL_F
;
1513 scm_remember_upto_here_1 (buf
);
1515 return scm_cons (scm_from_int (rv
), address
);
1519 SCM_DEFINE (scm_sendto
, "sendto", 3, 1, 1,
1520 (SCM sock
, SCM message
, SCM fam_or_sockaddr
, SCM address
, SCM args_and_flags
),
1521 "Transmit bytevector @var{message} on socket port\n"
1523 "destination address is specified using the @var{fam_or_sockaddr},\n"
1524 "@var{address} and\n"
1525 "@var{args_and_flags} arguments, or just a socket address object "
1526 "returned by @code{make-socket-address}, in a similar way to the\n"
1527 "@code{connect} procedure. @var{args_and_flags} contains\n"
1528 "the usual connection arguments optionally followed by\n"
1529 "a flags argument, which is a value or\n"
1530 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1531 "The value returned is the number of bytes transmitted --\n"
1532 "it's possible for\n"
1533 "this to be less than the length of @var{message} if the\n"
1535 "set to be non-blocking.\n"
1536 "Note that the data is written directly to the socket\n"
1537 "file descriptor:\n"
1538 "any unflushed buffered port data is ignored.\n"
1539 "This operation is defined only for strings containing codepoints\n"
1541 #define FUNC_NAME s_scm_sendto
1544 struct sockaddr
*soka
;
1547 sock
= SCM_COERCE_OUTPORT (sock
);
1548 SCM_VALIDATE_FPORT (1, sock
);
1549 fd
= SCM_FPORT_FDES (sock
);
1551 if (!scm_is_number (fam_or_sockaddr
))
1553 /* FAM_OR_SOCKADDR must actually be a `socket address' object. This
1554 means that the following arguments, i.e. ADDRESS and those listed in
1555 ARGS_AND_FLAGS, are the `MSG_' flags. */
1556 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
1557 if (!scm_is_eq (address
, SCM_UNDEFINED
))
1558 args_and_flags
= scm_cons (address
, args_and_flags
);
1561 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
1562 &args_and_flags
, 3, FUNC_NAME
, &size
);
1564 if (scm_is_null (args_and_flags
))
1568 SCM_VALIDATE_CONS (5, args_and_flags
);
1569 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
1572 SCM_VALIDATE_BYTEVECTOR (1, message
);
1574 SCM_SYSCALL (rv
= sendto (fd
,
1575 SCM_BYTEVECTOR_CONTENTS (message
),
1576 SCM_BYTEVECTOR_LENGTH (message
),
1581 int save_errno
= errno
;
1588 scm_remember_upto_here_1 (message
);
1589 return scm_from_int (rv
);
1598 /* protocol families. */
1600 scm_c_define ("AF_UNSPEC", scm_from_int (AF_UNSPEC
));
1602 #if defined HAVE_UNIX_DOMAIN_SOCKETS && defined AF_UNIX
1603 scm_c_define ("AF_UNIX", scm_from_int (AF_UNIX
));
1606 scm_c_define ("AF_INET", scm_from_int (AF_INET
));
1609 scm_c_define ("AF_INET6", scm_from_int (AF_INET6
));
1613 scm_c_define ("PF_UNSPEC", scm_from_int (PF_UNSPEC
));
1616 scm_c_define ("PF_UNIX", scm_from_int (PF_UNIX
));
1619 scm_c_define ("PF_INET", scm_from_int (PF_INET
));
1622 scm_c_define ("PF_INET6", scm_from_int (PF_INET6
));
1625 /* standard addresses. */
1627 scm_c_define ("INADDR_ANY", scm_from_ulong (INADDR_ANY
));
1629 #ifdef INADDR_BROADCAST
1630 scm_c_define ("INADDR_BROADCAST", scm_from_ulong (INADDR_BROADCAST
));
1633 scm_c_define ("INADDR_NONE", scm_from_ulong (INADDR_NONE
));
1635 #ifdef INADDR_LOOPBACK
1636 scm_c_define ("INADDR_LOOPBACK", scm_from_ulong (INADDR_LOOPBACK
));
1641 SOCK_PACKET is deliberately omitted, the GNU/Linux socket(2) and
1642 packet(7) advise that it's obsolete and strongly deprecated. */
1645 scm_c_define ("SOCK_STREAM", scm_from_int (SOCK_STREAM
));
1648 scm_c_define ("SOCK_DGRAM", scm_from_int (SOCK_DGRAM
));
1650 #ifdef SOCK_SEQPACKET
1651 scm_c_define ("SOCK_SEQPACKET", scm_from_int (SOCK_SEQPACKET
));
1654 scm_c_define ("SOCK_RAW", scm_from_int (SOCK_RAW
));
1657 scm_c_define ("SOCK_RDM", scm_from_int (SOCK_RDM
));
1660 /* setsockopt level.
1662 SOL_IP, SOL_TCP and SOL_UDP are defined on gnu/linux, but not on for
1663 instance NetBSD. We define IPPROTOs because that's what the posix spec
1664 shows in its example at
1666 http://www.opengroup.org/onlinepubs/007904975/functions/getsockopt.html
1669 scm_c_define ("SOL_SOCKET", scm_from_int (SOL_SOCKET
));
1672 scm_c_define ("IPPROTO_IP", scm_from_int (IPPROTO_IP
));
1675 scm_c_define ("IPPROTO_TCP", scm_from_int (IPPROTO_TCP
));
1678 scm_c_define ("IPPROTO_UDP", scm_from_int (IPPROTO_UDP
));
1681 /* setsockopt names. */
1683 scm_c_define ("SO_DEBUG", scm_from_int (SO_DEBUG
));
1686 scm_c_define ("SO_REUSEADDR", scm_from_int (SO_REUSEADDR
));
1689 scm_c_define ("SO_STYLE", scm_from_int (SO_STYLE
));
1692 scm_c_define ("SO_TYPE", scm_from_int (SO_TYPE
));
1695 scm_c_define ("SO_ERROR", scm_from_int (SO_ERROR
));
1698 scm_c_define ("SO_DONTROUTE", scm_from_int (SO_DONTROUTE
));
1701 scm_c_define ("SO_BROADCAST", scm_from_int (SO_BROADCAST
));
1704 scm_c_define ("SO_SNDBUF", scm_from_int (SO_SNDBUF
));
1707 scm_c_define ("SO_RCVBUF", scm_from_int (SO_RCVBUF
));
1710 scm_c_define ("SO_KEEPALIVE", scm_from_int (SO_KEEPALIVE
));
1713 scm_c_define ("SO_OOBINLINE", scm_from_int (SO_OOBINLINE
));
1716 scm_c_define ("SO_NO_CHECK", scm_from_int (SO_NO_CHECK
));
1719 scm_c_define ("SO_PRIORITY", scm_from_int (SO_PRIORITY
));
1722 scm_c_define ("SO_LINGER", scm_from_int (SO_LINGER
));
1724 #ifdef SO_REUSEPORT /* new in Linux 3.9 */
1725 scm_c_define ("SO_REUSEPORT", scm_from_int (SO_REUSEPORT
));
1728 /* recv/send options. */
1730 scm_c_define ("MSG_DONTWAIT", scm_from_int (MSG_DONTWAIT
));
1733 scm_c_define ("MSG_OOB", scm_from_int (MSG_OOB
));
1736 scm_c_define ("MSG_PEEK", scm_from_int (MSG_PEEK
));
1738 #ifdef MSG_DONTROUTE
1739 scm_c_define ("MSG_DONTROUTE", scm_from_int (MSG_DONTROUTE
));
1742 #ifdef IP_ADD_MEMBERSHIP
1743 scm_c_define ("IP_ADD_MEMBERSHIP", scm_from_int (IP_ADD_MEMBERSHIP
));
1744 scm_c_define ("IP_DROP_MEMBERSHIP", scm_from_int (IP_DROP_MEMBERSHIP
));
1747 #ifdef IP_MULTICAST_TTL
1748 scm_c_define ("IP_MULTICAST_TTL", scm_from_int ( IP_MULTICAST_TTL
));
1751 #ifdef IP_MULTICAST_IF
1752 scm_c_define ("IP_MULTICAST_IF", scm_from_int ( IP_MULTICAST_IF
));
1755 scm_add_feature ("socket");
1757 #include "libguile/socket.x"