1 /* Copyright (C) 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005,
2 * 2006, 2007, 2009, 2011, 2012, 2013 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 SCM_DEFINE (scm_htons
, "htons", 1, 0, 0,
97 "Convert a 16 bit quantity from host to network byte ordering.\n"
98 "@var{value} is packed into 2 bytes, which are then converted\n"
99 "and returned as a new integer.")
100 #define FUNC_NAME s_scm_htons
102 return scm_from_ushort (htons (scm_to_ushort (value
)));
106 SCM_DEFINE (scm_ntohs
, "ntohs", 1, 0, 0,
108 "Convert a 16 bit quantity from network to host byte ordering.\n"
109 "@var{value} is packed into 2 bytes, which are then converted\n"
110 "and returned as a new integer.")
111 #define FUNC_NAME s_scm_ntohs
113 return scm_from_ushort (ntohs (scm_to_ushort (value
)));
117 SCM_DEFINE (scm_htonl
, "htonl", 1, 0, 0,
119 "Convert a 32 bit quantity from host to network byte ordering.\n"
120 "@var{value} is packed into 4 bytes, which are then converted\n"
121 "and returned as a new integer.")
122 #define FUNC_NAME s_scm_htonl
124 return scm_from_ulong (htonl (scm_to_uint32 (value
)));
128 SCM_DEFINE (scm_ntohl
, "ntohl", 1, 0, 0,
130 "Convert a 32 bit quantity from network to host byte ordering.\n"
131 "@var{value} is packed into 4 bytes, which are then converted\n"
132 "and returned as a new integer.")
133 #define FUNC_NAME s_scm_ntohl
135 return scm_from_ulong (ntohl (scm_to_uint32 (value
)));
139 #ifdef HAVE_INET_NETOF
140 SCM_DEFINE (scm_inet_netof
, "inet-netof", 1, 0, 0,
142 "Return the network number part of the given IPv4\n"
143 "Internet address. E.g.,\n\n"
145 "(inet-netof 2130706433) @result{} 127\n"
147 #define FUNC_NAME s_scm_inet_netof
150 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
151 return scm_from_ulong (inet_netof (addr
));
156 #ifdef HAVE_INET_LNAOF
157 SCM_DEFINE (scm_lnaof
, "inet-lnaof", 1, 0, 0,
159 "Return the local-address-with-network part of the given\n"
160 "IPv4 Internet address, using the obsolete class A/B/C system.\n"
163 "(inet-lnaof 2130706433) @result{} 1\n"
165 #define FUNC_NAME s_scm_lnaof
168 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
169 return scm_from_ulong (inet_lnaof (addr
));
174 #ifdef HAVE_INET_MAKEADDR
175 SCM_DEFINE (scm_inet_makeaddr
, "inet-makeaddr", 2, 0, 0,
177 "Make an IPv4 Internet address by combining the network number\n"
178 "@var{net} with the local-address-within-network number\n"
179 "@var{lna}. E.g.,\n\n"
181 "(inet-makeaddr 127 1) @result{} 2130706433\n"
183 #define FUNC_NAME s_scm_inet_makeaddr
186 unsigned long netnum
;
187 unsigned long lnanum
;
189 netnum
= SCM_NUM2ULONG (1, net
);
190 lnanum
= SCM_NUM2ULONG (2, lna
);
191 addr
= inet_makeaddr (netnum
, lnanum
);
192 return scm_from_ulong (ntohl (addr
.s_addr
));
199 /* flip a 128 bit IPv6 address between host and network order. */
200 #ifdef WORDS_BIGENDIAN
201 #define FLIP_NET_HOST_128(addr)
203 #define FLIP_NET_HOST_128(addr)\
207 for (i = 0; i < 8; i++)\
209 scm_t_uint8 c = (addr)[i];\
211 (addr)[i] = (addr)[15 - i];\
217 #ifdef WORDS_BIGENDIAN
218 #define FLIPCPY_NET_HOST_128(dest, src) memcpy (dest, src, 16)
220 #define FLIPCPY_NET_HOST_128(dest, src) \
222 const scm_t_uint8 *tmp_srcp = (src) + 15; \
223 scm_t_uint8 *tmp_destp = (dest); \
226 *tmp_destp++ = *tmp_srcp--; \
227 } while (tmp_srcp != (src)); \
232 #if (SIZEOF_SCM_T_BITS * SCM_CHAR_BIT) > 128
233 #error "Assumption that scm_t_bits <= 128 bits has been violated."
236 #if (SIZEOF_UNSIGNED_LONG * SCM_CHAR_BIT) > 128
237 #error "Assumption that unsigned long <= 128 bits has been violated."
240 #if (SIZEOF_UNSIGNED_LONG_LONG * SCM_CHAR_BIT) > 128
241 #error "Assumption that unsigned long long <= 128 bits has been violated."
244 /* convert a 128 bit IPv6 address in network order to a host ordered
247 scm_from_ipv6 (const scm_t_uint8
*src
)
249 SCM result
= scm_i_mkbig ();
250 mpz_import (SCM_I_BIG_MPZ (result
),
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 */
257 return scm_i_normbig (result
);
260 /* convert a host ordered SCM integer to a 128 bit IPv6 address in
263 scm_to_ipv6 (scm_t_uint8 dst
[16], SCM src
)
265 if (SCM_I_INUMP (src
))
267 scm_t_signed_bits n
= SCM_I_INUM (src
);
269 scm_out_of_range (NULL
, src
);
270 #ifdef WORDS_BIGENDIAN
271 memset (dst
, 0, 16 - sizeof (scm_t_signed_bits
));
272 memcpy (dst
+ (16 - sizeof (scm_t_signed_bits
)),
274 sizeof (scm_t_signed_bits
));
276 memset (dst
+ sizeof (scm_t_signed_bits
),
278 16 - sizeof (scm_t_signed_bits
));
279 /* FIXME: this pair of ops is kinda wasteful -- should rewrite as
280 a single loop perhaps, similar to the handling of bignums. */
281 memcpy (dst
, &n
, sizeof (scm_t_signed_bits
));
282 FLIP_NET_HOST_128 (dst
);
285 else if (SCM_BIGP (src
))
289 if ((mpz_sgn (SCM_I_BIG_MPZ (src
)) < 0)
290 || mpz_sizeinbase (SCM_I_BIG_MPZ (src
), 2) > 128)
291 scm_out_of_range (NULL
, src
);
296 1, /* big-endian chunk ordering */
297 16, /* chunks are 16 bytes long */
298 1, /* big-endian byte ordering */
299 0, /* "nails" -- leading unused bits per chunk */
300 SCM_I_BIG_MPZ (src
));
301 scm_remember_upto_here_1 (src
);
304 scm_wrong_type_arg_msg ("scm_to_ipv6", 0, src
, "integer");
307 #endif /* HAVE_IPV6 */
311 SCM_DEFINE (scm_inet_ntop
, "inet-ntop", 2, 0, 0,
312 (SCM family
, SCM address
),
313 "Convert a network address into a printable string.\n"
314 "Note that unlike the C version of this function,\n"
315 "the input is an integer with normal host byte ordering.\n"
316 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
318 "(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
319 "(inet-ntop AF_INET6 (- (expt 2 128) 1))\n"
320 " @result{} \"ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\"\n"
322 #define FUNC_NAME s_scm_inet_ntop
325 #ifdef INET6_ADDRSTRLEN
326 char dst
[INET6_ADDRSTRLEN
];
332 af
= scm_to_int (family
);
333 SCM_ASSERT_RANGE (1, family
,
343 addr4
= htonl (SCM_NUM2ULONG (2, address
));
344 result
= inet_ntop (af
, &addr4
, dst
, sizeof (dst
));
347 else if (af
== AF_INET6
)
351 scm_to_ipv6 ((scm_t_uint8
*) addr6
, address
);
352 result
= inet_ntop (af
, &addr6
, dst
, sizeof (dst
));
356 SCM_MISC_ERROR ("unsupported address family", family
);
361 return scm_from_locale_string (dst
);
365 SCM_DEFINE (scm_inet_pton
, "inet-pton", 2, 0, 0,
366 (SCM family
, SCM address
),
367 "Convert a string containing a printable network address to\n"
368 "an integer address. Note that unlike the C version of this\n"
370 "the result is an integer with normal host byte ordering.\n"
371 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
373 "(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
374 "(inet-pton AF_INET6 \"::1\") @result{} 1\n"
376 #define FUNC_NAME s_scm_inet_pton
383 af
= scm_to_int (family
);
384 SCM_ASSERT_RANGE (1, family
,
391 src
= scm_to_locale_string (address
);
392 rv
= inet_pton (af
, src
, dst
);
400 SCM_MISC_ERROR ("Bad address", SCM_EOL
);
402 return scm_from_ulong (ntohl (*dst
));
404 else if (af
== AF_INET6
)
405 return scm_from_ipv6 ((scm_t_uint8
*) dst
);
408 SCM_MISC_ERROR ("unsupported address family", family
);
413 SCM_SYMBOL (sym_socket
, "socket");
415 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
417 SCM_DEFINE (scm_socket
, "socket", 3, 0, 0,
418 (SCM family
, SCM style
, SCM proto
),
419 "Return a new socket port of the type specified by @var{family},\n"
420 "@var{style} and @var{proto}. All three parameters are\n"
421 "integers. Supported values for @var{family} are\n"
422 "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
423 "Typical values for @var{style} are @code{SOCK_STREAM},\n"
424 "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
425 "@var{proto} can be obtained from a protocol name using\n"
426 "@code{getprotobyname}. A value of zero specifies the default\n"
427 "protocol, which is usually right.\n\n"
428 "A single socket port cannot by used for communication until it\n"
429 "has been connected to another socket.")
430 #define FUNC_NAME s_scm_socket
434 fd
= socket (scm_to_int (family
),
439 return SCM_SOCK_FD_TO_PORT (fd
);
443 #ifdef HAVE_SOCKETPAIR
444 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
445 (SCM family
, SCM style
, SCM proto
),
446 "Return a pair of connected (but unnamed) socket ports of the\n"
447 "type specified by @var{family}, @var{style} and @var{proto}.\n"
448 "Many systems support only socket pairs of the @code{AF_UNIX}\n"
449 "family. Zero is likely to be the only meaningful value for\n"
451 #define FUNC_NAME s_scm_socketpair
456 fam
= scm_to_int (family
);
458 if (socketpair (fam
, scm_to_int (style
), scm_to_int (proto
), fd
) == -1)
461 return scm_cons (SCM_SOCK_FD_TO_PORT (fd
[0]), SCM_SOCK_FD_TO_PORT (fd
[1]));
466 /* Possible results for `getsockopt ()'. Wrapping it into a union guarantees
467 suitable alignment. */
470 #ifdef HAVE_STRUCT_LINGER
471 struct linger linger
;
475 } scm_t_getsockopt_result
;
477 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
478 (SCM sock
, SCM level
, SCM optname
),
479 "Return an option value from socket port @var{sock}.\n"
481 "@var{level} is an integer specifying a protocol layer, either\n"
482 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
483 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
484 "(@pxref{Network Databases}).\n"
486 "@defvar SOL_SOCKET\n"
487 "@defvarx IPPROTO_IP\n"
488 "@defvarx IPPROTO_TCP\n"
489 "@defvarx IPPROTO_UDP\n"
492 "@var{optname} is an integer specifying an option within the\n"
495 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
496 "defined (when provided by the system). For their meaning see\n"
497 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
498 "Manual}, or @command{man 7 socket}.\n"
501 "@defvarx SO_REUSEADDR\n"
502 "@defvarx SO_STYLE\n"
504 "@defvarx SO_ERROR\n"
505 "@defvarx SO_DONTROUTE\n"
506 "@defvarx SO_BROADCAST\n"
507 "@defvarx SO_SNDBUF\n"
508 "@defvarx SO_RCVBUF\n"
509 "@defvarx SO_KEEPALIVE\n"
510 "@defvarx SO_OOBINLINE\n"
511 "@defvarx SO_NO_CHECK\n"
512 "@defvarx SO_PRIORITY\n"
513 "@defvarx SO_REUSEPORT\n"
514 "The value returned is an integer.\n"
517 "@defvar SO_LINGER\n"
518 "The value returned is a pair of integers\n"
519 "@code{(@var{enable} . @var{timeout})}. On old systems without\n"
520 "timeout support (ie.@: without @code{struct linger}), only\n"
521 "@var{enable} has an effect but the value in Guile is always a\n"
524 #define FUNC_NAME s_scm_getsockopt
527 /* size of optval is the largest supported option. */
528 scm_t_getsockopt_result optval
;
529 socklen_t optlen
= sizeof (optval
);
533 sock
= SCM_COERCE_OUTPORT (sock
);
534 SCM_VALIDATE_OPFPORT (1, sock
);
535 ilevel
= scm_to_int (level
);
536 ioptname
= scm_to_int (optname
);
538 fd
= SCM_FPORT_FDES (sock
);
539 if (getsockopt (fd
, ilevel
, ioptname
, (void *) &optval
, &optlen
) == -1)
542 if (ilevel
== SOL_SOCKET
)
545 if (ioptname
== SO_LINGER
)
547 #ifdef HAVE_STRUCT_LINGER
548 struct linger
*ling
= (struct linger
*) &optval
;
550 return scm_cons (scm_from_long (ling
->l_onoff
),
551 scm_from_long (ling
->l_linger
));
553 return scm_cons (scm_from_long (*(int *) &optval
),
561 || ioptname
== SO_SNDBUF
564 || ioptname
== SO_RCVBUF
568 return scm_from_size_t (*(size_t *) &optval
);
571 return scm_from_int (*(int *) &optval
);
575 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
576 (SCM sock
, SCM level
, SCM optname
, SCM value
),
577 "Set an option on socket port @var{sock}. The return value is\n"
580 "@var{level} is an integer specifying a protocol layer, either\n"
581 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
582 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
583 "(@pxref{Network Databases}).\n"
585 "@defvar SOL_SOCKET\n"
586 "@defvarx IPPROTO_IP\n"
587 "@defvarx IPPROTO_TCP\n"
588 "@defvarx IPPROTO_UDP\n"
591 "@var{optname} is an integer specifying an option within the\n"
594 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
595 "defined (when provided by the system). For their meaning see\n"
596 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
597 "Manual}, or @command{man 7 socket}.\n"
600 "@defvarx SO_REUSEADDR\n"
601 "@defvarx SO_STYLE\n"
603 "@defvarx SO_ERROR\n"
604 "@defvarx SO_DONTROUTE\n"
605 "@defvarx SO_BROADCAST\n"
606 "@defvarx SO_SNDBUF\n"
607 "@defvarx SO_RCVBUF\n"
608 "@defvarx SO_KEEPALIVE\n"
609 "@defvarx SO_OOBINLINE\n"
610 "@defvarx SO_NO_CHECK\n"
611 "@defvarx SO_PRIORITY\n"
612 "@defvarx SO_REUSEPORT\n"
613 "@var{value} is an integer.\n"
616 "@defvar SO_LINGER\n"
617 "@var{value} is a pair of integers @code{(@var{ENABLE}\n"
618 ". @var{TIMEOUT})}. On old systems without timeout support\n"
619 "(ie.@: without @code{struct linger}), only @var{ENABLE} has an\n"
620 "effect but the value in Guile is always a pair.\n"
623 "@c Note that we refer only to ``man ip'' here. On GNU/Linux it's\n"
624 "@c ``man 7 ip'' but on NetBSD it's ``man 4 ip''.\n"
626 "For IP level (@code{IPPROTO_IP}) the following @var{optname}s\n"
627 "are defined (when provided by the system). See @command{man\n"
628 "ip} for what they mean.\n"
630 "@defvar IP_MULTICAST_IF\n"
631 "This sets the source interface used by multicast traffic.\n"
634 "@defvar IP_MULTICAST_TTL\n"
635 "This sets the default TTL for multicast traffic. This defaults \n"
636 "to 1 and should be increased to allow traffic to pass beyond the\n"
640 "@defvar IP_ADD_MEMBERSHIP\n"
641 "@defvarx IP_DROP_MEMBERSHIP\n"
642 "These can be used only with @code{setsockopt}, not\n"
643 "@code{getsockopt}. @var{value} is a pair\n"
644 "@code{(@var{MULTIADDR} . @var{INTERFACEADDR})} of IPv4\n"
645 "addresses (@pxref{Network Address Conversion}).\n"
646 "@var{MULTIADDR} is a multicast address to be added to or\n"
647 "dropped from the interface @var{INTERFACEADDR}.\n"
648 "@var{INTERFACEADDR} can be @code{INADDR_ANY} to have the system\n"
649 "select the interface. @var{INTERFACEADDR} can also be an\n"
650 "interface index number, on systems supporting that.\n"
652 #define FUNC_NAME s_scm_setsockopt
657 #ifdef HAVE_STRUCT_LINGER
658 struct linger opt_linger
;
661 #ifdef HAVE_STRUCT_IP_MREQ
662 struct ip_mreq opt_mreq
;
665 const void *optval
= NULL
;
666 socklen_t optlen
= 0;
668 int ilevel
, ioptname
;
670 sock
= SCM_COERCE_OUTPORT (sock
);
672 SCM_VALIDATE_OPFPORT (1, sock
);
673 ilevel
= scm_to_int (level
);
674 ioptname
= scm_to_int (optname
);
676 fd
= SCM_FPORT_FDES (sock
);
678 if (ilevel
== SOL_SOCKET
)
681 if (ioptname
== SO_LINGER
)
683 #ifdef HAVE_STRUCT_LINGER
684 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
685 opt_linger
.l_onoff
= scm_to_int (SCM_CAR (value
));
686 opt_linger
.l_linger
= scm_to_int (SCM_CDR (value
));
687 optlen
= sizeof (struct linger
);
688 optval
= &opt_linger
;
690 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
691 opt_int
= scm_to_int (SCM_CAR (value
));
692 /* timeout is ignored, but may as well validate it. */
693 scm_to_int (SCM_CDR (value
));
694 optlen
= sizeof (int);
702 || ioptname
== SO_SNDBUF
705 || ioptname
== SO_RCVBUF
709 opt_int
= scm_to_int (value
);
710 optlen
= sizeof (size_t);
715 #ifdef HAVE_STRUCT_IP_MREQ
716 if (ilevel
== IPPROTO_IP
&&
717 (ioptname
== IP_ADD_MEMBERSHIP
|| ioptname
== IP_DROP_MEMBERSHIP
))
719 /* Fourth argument must be a pair of addresses. */
720 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
721 opt_mreq
.imr_multiaddr
.s_addr
= htonl (scm_to_ulong (SCM_CAR (value
)));
722 opt_mreq
.imr_interface
.s_addr
= htonl (scm_to_ulong (SCM_CDR (value
)));
723 optlen
= sizeof (opt_mreq
);
730 /* Most options take an int. */
731 opt_int
= scm_to_int (value
);
732 optlen
= sizeof (int);
736 if (setsockopt (fd
, ilevel
, ioptname
, optval
, optlen
) == -1)
738 return SCM_UNSPECIFIED
;
742 /* Our documentation hard-codes this mapping, so make sure it holds. */
743 verify (SHUT_RD
== 0);
744 verify (SHUT_WR
== 1);
745 verify (SHUT_RDWR
== 2);
747 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
749 "Sockets can be closed simply by using @code{close-port}. The\n"
750 "@code{shutdown} procedure allows reception or transmission on a\n"
751 "connection to be shut down individually, according to the parameter\n"
755 "Stop receiving data for this socket. If further data arrives, reject it.\n"
757 "Stop trying to transmit data from this socket. Discard any\n"
758 "data waiting to be sent. Stop looking for acknowledgement of\n"
759 "data already sent; don't retransmit it if it is lost.\n"
761 "Stop both reception and transmission.\n"
763 "The return value is unspecified.")
764 #define FUNC_NAME s_scm_shutdown
767 sock
= SCM_COERCE_OUTPORT (sock
);
768 SCM_VALIDATE_OPFPORT (1, sock
);
769 fd
= SCM_FPORT_FDES (sock
);
770 if (shutdown (fd
, scm_to_signed_integer (how
, 0, 2)) == -1)
772 return SCM_UNSPECIFIED
;
776 /* convert fam/address/args into a sockaddr of the appropriate type.
777 args is modified by removing the arguments actually used.
778 which_arg and proc are used when reporting errors:
779 which_arg is the position of address in the original argument list.
780 proc is the name of the original procedure.
781 size returns the size of the structure allocated. */
783 static struct sockaddr
*
784 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
785 const char *proc
, size_t *size
)
786 #define FUNC_NAME proc
792 struct sockaddr_in
*soka
;
796 SCM_VALIDATE_ULONG_COPY (which_arg
, address
, addr
);
797 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
798 port
= scm_to_int (SCM_CAR (*args
));
799 *args
= SCM_CDR (*args
);
800 soka
= (struct sockaddr_in
*) scm_malloc (sizeof (struct sockaddr_in
));
801 memset (soka
, '\0', sizeof (struct sockaddr_in
));
803 #ifdef HAVE_STRUCT_SOCKADDR_IN_SIN_LEN
804 soka
->sin_len
= sizeof (struct sockaddr_in
);
806 soka
->sin_family
= AF_INET
;
807 soka
->sin_addr
.s_addr
= htonl (addr
);
808 soka
->sin_port
= htons (port
);
809 *size
= sizeof (struct sockaddr_in
);
810 return (struct sockaddr
*) soka
;
817 struct sockaddr_in6
*soka
;
818 unsigned long flowinfo
= 0;
819 unsigned long scope_id
= 0;
821 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
822 port
= scm_to_int (SCM_CAR (*args
));
823 *args
= SCM_CDR (*args
);
824 if (scm_is_pair (*args
))
826 SCM_VALIDATE_ULONG_COPY (which_arg
+ 2, SCM_CAR (*args
), flowinfo
);
827 *args
= SCM_CDR (*args
);
828 if (scm_is_pair (*args
))
830 SCM_VALIDATE_ULONG_COPY (which_arg
+ 3, SCM_CAR (*args
),
832 *args
= SCM_CDR (*args
);
835 soka
= (struct sockaddr_in6
*) scm_malloc (sizeof (struct sockaddr_in6
));
837 #ifdef HAVE_STRUCT_SOCKADDR_IN6_SIN6_LEN
838 soka
->sin6_len
= sizeof (struct sockaddr_in6
);
840 soka
->sin6_family
= AF_INET6
;
841 scm_to_ipv6 (soka
->sin6_addr
.s6_addr
, address
);
842 soka
->sin6_port
= htons (port
);
843 soka
->sin6_flowinfo
= flowinfo
;
844 #ifdef HAVE_SIN6_SCOPE_ID
845 soka
->sin6_scope_id
= scope_id
;
847 *size
= sizeof (struct sockaddr_in6
);
848 return (struct sockaddr
*) soka
;
851 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
854 struct sockaddr_un
*soka
;
858 scm_dynwind_begin (0);
860 c_address
= scm_to_locale_string (address
);
861 scm_dynwind_free (c_address
);
863 /* the static buffer size in sockaddr_un seems to be arbitrary
864 and not necessarily a hard limit. e.g., the glibc manual
865 suggests it may be possible to declare it size 0. let's
866 ignore it. if the O/S doesn't like the size it will cause
867 connect/bind etc., to fail. sun_path is always the last
868 member of the structure. */
869 addr_size
= sizeof (struct sockaddr_un
)
870 + max (0, strlen (c_address
) + 1 - (sizeof soka
->sun_path
));
871 soka
= (struct sockaddr_un
*) scm_malloc (addr_size
);
872 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
873 soka
->sun_family
= AF_UNIX
;
874 strcpy (soka
->sun_path
, c_address
);
875 *size
= SUN_LEN (soka
);
878 return (struct sockaddr
*) soka
;
882 scm_out_of_range (proc
, scm_from_int (fam
));
887 SCM_DEFINE (scm_connect
, "connect", 2, 1, 1,
888 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
889 "Initiate a connection from a socket using a specified address\n"
890 "family to the address\n"
891 "specified by @var{address} and possibly @var{args}.\n"
892 "The format required for @var{address}\n"
893 "and @var{args} depends on the family of the socket.\n\n"
894 "For a socket of family @code{AF_UNIX},\n"
895 "only @var{address} is specified and must be a string with the\n"
896 "filename where the socket is to be created.\n\n"
897 "For a socket of family @code{AF_INET},\n"
898 "@var{address} must be an integer IPv4 host address and\n"
899 "@var{args} must be a single integer port number.\n\n"
900 "For a socket of family @code{AF_INET6},\n"
901 "@var{address} must be an integer IPv6 host address and\n"
902 "@var{args} may be up to three integers:\n"
903 "port [flowinfo] [scope_id],\n"
904 "where flowinfo and scope_id default to zero.\n\n"
905 "Alternatively, the second argument can be a socket address object "
906 "as returned by @code{make-socket-address}, in which case the "
907 "no additional arguments should be passed.\n\n"
908 "The return value is unspecified.")
909 #define FUNC_NAME s_scm_connect
912 struct sockaddr
*soka
;
915 sock
= SCM_COERCE_OUTPORT (sock
);
916 SCM_VALIDATE_OPFPORT (1, sock
);
917 fd
= SCM_FPORT_FDES (sock
);
919 if (scm_is_eq (address
, SCM_UNDEFINED
))
920 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
921 `socket address' object. */
922 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
924 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
925 &args
, 3, FUNC_NAME
, &size
);
927 if (connect (fd
, soka
, size
) == -1)
929 int save_errno
= errno
;
936 return SCM_UNSPECIFIED
;
940 SCM_DEFINE (scm_bind
, "bind", 2, 1, 1,
941 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
942 "Assign an address to the socket port @var{sock}.\n"
943 "Generally this only needs to be done for server sockets,\n"
944 "so they know where to look for incoming connections. A socket\n"
945 "without an address will be assigned one automatically when it\n"
946 "starts communicating.\n\n"
947 "The format of @var{address} and @var{args} depends\n"
948 "on the family of the socket.\n\n"
949 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
950 "is specified and must be a string with the filename where\n"
951 "the socket is to be created.\n\n"
952 "For a socket of family @code{AF_INET}, @var{address}\n"
953 "must be an integer IPv4 address and @var{args}\n"
954 "must be a single integer port number.\n\n"
955 "The values of the following variables can also be used for\n"
957 "@defvar INADDR_ANY\n"
958 "Allow connections from any address.\n"
960 "@defvar INADDR_LOOPBACK\n"
961 "The address of the local host using the loopback device.\n"
963 "@defvar INADDR_BROADCAST\n"
964 "The broadcast address on the local network.\n"
966 "@defvar INADDR_NONE\n"
969 "For a socket of family @code{AF_INET6}, @var{address}\n"
970 "must be an integer IPv6 address and @var{args}\n"
971 "may be up to three integers:\n"
972 "port [flowinfo] [scope_id],\n"
973 "where flowinfo and scope_id default to zero.\n\n"
974 "Alternatively, the second argument can be a socket address object "
975 "as returned by @code{make-socket-address}, in which case the "
976 "no additional arguments should be passed.\n\n"
977 "The return value is unspecified.")
978 #define FUNC_NAME s_scm_bind
980 struct sockaddr
*soka
;
984 sock
= SCM_COERCE_OUTPORT (sock
);
985 SCM_VALIDATE_OPFPORT (1, sock
);
986 fd
= SCM_FPORT_FDES (sock
);
988 if (scm_is_eq (address
, SCM_UNDEFINED
))
989 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
990 `socket address' object. */
991 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
993 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
994 &args
, 3, FUNC_NAME
, &size
);
997 if (bind (fd
, soka
, size
) == -1)
999 int save_errno
= errno
;
1006 return SCM_UNSPECIFIED
;
1010 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
1011 (SCM sock
, SCM backlog
),
1012 "Enable @var{sock} to accept connection\n"
1013 "requests. @var{backlog} is an integer specifying\n"
1014 "the maximum length of the queue for pending connections.\n"
1015 "If the queue fills, new clients will fail to connect until\n"
1016 "the server calls @code{accept} to accept a connection from\n"
1018 "The return value is unspecified.")
1019 #define FUNC_NAME s_scm_listen
1022 sock
= SCM_COERCE_OUTPORT (sock
);
1023 SCM_VALIDATE_OPFPORT (1, sock
);
1024 fd
= SCM_FPORT_FDES (sock
);
1025 if (listen (fd
, scm_to_int (backlog
)) == -1)
1027 return SCM_UNSPECIFIED
;
1031 /* Put the components of a sockaddr into a new SCM vector. */
1032 static SCM_C_INLINE_KEYWORD SCM
1033 _scm_from_sockaddr (const scm_t_max_sockaddr
*address
, unsigned addr_size
,
1036 SCM result
= SCM_EOL
;
1037 short int fam
= ((struct sockaddr
*) address
)->sa_family
;
1043 const struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
1045 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
1047 SCM_SIMPLE_VECTOR_SET(result
, 0,
1048 scm_from_short (fam
));
1049 SCM_SIMPLE_VECTOR_SET(result
, 1,
1050 scm_from_ulong (ntohl (nad
->sin_addr
.s_addr
)));
1051 SCM_SIMPLE_VECTOR_SET(result
, 2,
1052 scm_from_ushort (ntohs (nad
->sin_port
)));
1058 const struct sockaddr_in6
*nad
= (struct sockaddr_in6
*) address
;
1060 result
= scm_c_make_vector (5, SCM_UNSPECIFIED
);
1061 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1062 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_ipv6 (nad
->sin6_addr
.s6_addr
));
1063 SCM_SIMPLE_VECTOR_SET(result
, 2, scm_from_ushort (ntohs (nad
->sin6_port
)));
1064 SCM_SIMPLE_VECTOR_SET(result
, 3, scm_from_uint32 (nad
->sin6_flowinfo
));
1065 #ifdef HAVE_SIN6_SCOPE_ID
1066 SCM_SIMPLE_VECTOR_SET(result
, 4, scm_from_ulong (nad
->sin6_scope_id
));
1068 SCM_SIMPLE_VECTOR_SET(result
, 4, SCM_INUM0
);
1073 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1076 const struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
1078 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
1080 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1081 /* When addr_size is not enough to cover sun_path, do not try
1083 if (addr_size
<= offsetof (struct sockaddr_un
, sun_path
))
1084 SCM_SIMPLE_VECTOR_SET(result
, 1, SCM_BOOL_F
);
1086 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_locale_string (nad
->sun_path
));
1091 result
= SCM_UNSPECIFIED
;
1092 scm_misc_error (proc
, "unrecognised address family: ~A",
1093 scm_list_1 (scm_from_int (fam
)));
1099 /* The publicly-visible function. Return a Scheme object representing
1100 ADDRESS, an address of ADDR_SIZE bytes. */
1102 scm_from_sockaddr (const struct sockaddr
*address
, unsigned addr_size
)
1104 return (_scm_from_sockaddr ((scm_t_max_sockaddr
*) address
,
1105 addr_size
, "scm_from_sockaddr"));
1108 /* Convert ADDRESS, an address object returned by either
1109 `scm_from_sockaddr ()' or `scm_make_socket_address ()', into its C
1110 representation. On success, a non-NULL pointer is returned and
1111 ADDRESS_SIZE is updated to the actual size (in bytes) of the returned
1112 address. The result must eventually be freed using `free ()'. */
1114 scm_to_sockaddr (SCM address
, size_t *address_size
)
1115 #define FUNC_NAME "scm_to_sockaddr"
1118 struct sockaddr
*c_address
= NULL
;
1120 SCM_VALIDATE_VECTOR (1, address
);
1123 family
= scm_to_short (SCM_SIMPLE_VECTOR_REF (address
, 0));
1129 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 3)
1130 scm_misc_error (FUNC_NAME
,
1131 "invalid inet address representation: ~A",
1132 scm_list_1 (address
));
1135 struct sockaddr_in c_inet
;
1137 memset (&c_inet
, '\0', sizeof (struct sockaddr_in
));
1139 #ifdef HAVE_STRUCT_SOCKADDR_IN_SIN_LEN
1140 c_inet
.sin_len
= sizeof (struct sockaddr_in
);
1143 c_inet
.sin_addr
.s_addr
=
1144 htonl (scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 1)));
1146 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1147 c_inet
.sin_family
= AF_INET
;
1149 *address_size
= sizeof (c_inet
);
1150 c_address
= scm_malloc (sizeof (c_inet
));
1151 memcpy (c_address
, &c_inet
, sizeof (c_inet
));
1160 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 5)
1161 scm_misc_error (FUNC_NAME
, "invalid inet6 address representation: ~A",
1162 scm_list_1 (address
));
1165 struct sockaddr_in6 c_inet6
;
1167 scm_to_ipv6 (c_inet6
.sin6_addr
.s6_addr
,
1168 SCM_SIMPLE_VECTOR_REF (address
, 1));
1170 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1171 c_inet6
.sin6_flowinfo
=
1172 scm_to_uint32 (SCM_SIMPLE_VECTOR_REF (address
, 3));
1173 #ifdef HAVE_SIN6_SCOPE_ID
1174 c_inet6
.sin6_scope_id
=
1175 scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 4));
1178 c_inet6
.sin6_family
= AF_INET6
;
1180 *address_size
= sizeof (c_inet6
);
1181 c_address
= scm_malloc (sizeof (c_inet6
));
1182 memcpy (c_address
, &c_inet6
, sizeof (c_inet6
));
1189 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1192 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 2)
1193 scm_misc_error (FUNC_NAME
, "invalid unix address representation: ~A",
1194 scm_list_1 (address
));
1198 size_t path_len
= 0;
1200 path
= SCM_SIMPLE_VECTOR_REF (address
, 1);
1201 if (!scm_is_string (path
) && !scm_is_false (path
))
1202 scm_misc_error (FUNC_NAME
, "invalid unix address "
1203 "path: ~A", scm_list_1 (path
));
1206 struct sockaddr_un c_unix
;
1208 if (scm_is_false (path
))
1211 path_len
= scm_c_string_length (path
);
1213 #ifdef UNIX_PATH_MAX
1214 if (path_len
>= UNIX_PATH_MAX
)
1216 /* We can hope that this limit will eventually vanish, at least on GNU.
1217 However, currently, while glibc doesn't define `UNIX_PATH_MAX', it
1218 documents it has being limited to 108 bytes. */
1219 if (path_len
>= sizeof (c_unix
.sun_path
))
1221 scm_misc_error (FUNC_NAME
, "unix address path "
1222 "too long: ~A", scm_list_1 (path
));
1227 scm_to_locale_stringbuf (path
, c_unix
.sun_path
,
1228 #ifdef UNIX_PATH_MAX
1231 sizeof (c_unix
.sun_path
));
1233 c_unix
.sun_path
[path_len
] = '\0';
1236 if (strlen (c_unix
.sun_path
) != path_len
)
1237 scm_misc_error (FUNC_NAME
, "unix address path "
1238 "contains nul characters: ~A",
1242 c_unix
.sun_path
[0] = '\0';
1244 c_unix
.sun_family
= AF_UNIX
;
1246 *address_size
= SUN_LEN (&c_unix
);
1247 c_address
= scm_malloc (sizeof (c_unix
));
1248 memcpy (c_address
, &c_unix
, sizeof (c_unix
));
1258 scm_misc_error (FUNC_NAME
, "unrecognised address family: ~A",
1259 scm_list_1 (scm_from_ushort (family
)));
1267 /* Return a newly-allocated `sockaddr' structure that reflects ADDRESS, being
1268 an address of family FAMILY, with the family-specific parameters ARGS (see
1269 the description of `connect' for details). The returned structure may be
1270 freed using `free ()'. */
1272 scm_c_make_socket_address (SCM family
, SCM address
, SCM args
,
1273 size_t *address_size
)
1275 struct sockaddr
*soka
;
1277 soka
= scm_fill_sockaddr (scm_to_ushort (family
), address
, &args
, 1,
1278 "scm_c_make_socket_address", address_size
);
1283 SCM_DEFINE (scm_make_socket_address
, "make-socket-address", 2, 0, 1,
1284 (SCM family
, SCM address
, SCM args
),
1285 "Return a Scheme address object that reflects @var{address}, "
1286 "being an address of family @var{family}, with the "
1287 "family-specific parameters @var{args} (see the description of "
1288 "@code{connect} for details).")
1289 #define FUNC_NAME s_scm_make_socket_address
1291 SCM result
= SCM_BOOL_F
;
1292 struct sockaddr
*c_address
;
1293 size_t c_address_size
;
1295 c_address
= scm_c_make_socket_address (family
, address
, args
,
1297 if (c_address
!= NULL
)
1299 result
= scm_from_sockaddr (c_address
, c_address_size
);
1308 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
1310 "Accept a connection on a bound, listening socket.\n"
1312 "are no pending connections in the queue, wait until\n"
1313 "one is available unless the non-blocking option has been\n"
1314 "set on the socket.\n\n"
1315 "The return value is a\n"
1316 "pair in which the @emph{car} is a new socket port for the\n"
1318 "the @emph{cdr} is an object with address information about the\n"
1319 "client which initiated the connection.\n\n"
1320 "@var{sock} does not become part of the\n"
1321 "connection and will continue to accept new requests.")
1322 #define FUNC_NAME s_scm_accept
1328 socklen_t addr_size
= MAX_ADDR_SIZE
;
1329 scm_t_max_sockaddr addr
;
1331 sock
= SCM_COERCE_OUTPORT (sock
);
1332 SCM_VALIDATE_OPFPORT (1, sock
);
1333 fd
= SCM_FPORT_FDES (sock
);
1334 SCM_SYSCALL (newfd
= accept (fd
, (struct sockaddr
*) &addr
, &addr_size
));
1337 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
1338 address
= _scm_from_sockaddr (&addr
, addr_size
,
1341 return scm_cons (newsock
, address
);
1345 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
1347 "Return the address of @var{sock}, in the same form as the\n"
1348 "object returned by @code{accept}. On many systems the address\n"
1349 "of a socket in the @code{AF_FILE} namespace cannot be read.")
1350 #define FUNC_NAME s_scm_getsockname
1353 socklen_t addr_size
= MAX_ADDR_SIZE
;
1354 scm_t_max_sockaddr addr
;
1356 sock
= SCM_COERCE_OUTPORT (sock
);
1357 SCM_VALIDATE_OPFPORT (1, sock
);
1358 fd
= SCM_FPORT_FDES (sock
);
1359 if (getsockname (fd
, (struct sockaddr
*) &addr
, &addr_size
) == -1)
1362 return _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1366 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
1368 "Return the address that @var{sock}\n"
1369 "is connected to, in the same form as the object returned by\n"
1370 "@code{accept}. On many systems the address of a socket in the\n"
1371 "@code{AF_FILE} namespace cannot be read.")
1372 #define FUNC_NAME s_scm_getpeername
1375 socklen_t addr_size
= MAX_ADDR_SIZE
;
1376 scm_t_max_sockaddr addr
;
1378 sock
= SCM_COERCE_OUTPORT (sock
);
1379 SCM_VALIDATE_OPFPORT (1, sock
);
1380 fd
= SCM_FPORT_FDES (sock
);
1381 if (getpeername (fd
, (struct sockaddr
*) &addr
, &addr_size
) == -1)
1384 return _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1388 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
1389 (SCM sock
, SCM buf
, SCM flags
),
1390 "Receive data from a socket port.\n"
1391 "@var{sock} must already\n"
1392 "be bound to the address from which data is to be received.\n"
1393 "@var{buf} is a bytevector into which\n"
1394 "the data will be written. The size of @var{buf} limits\n"
1396 "data which can be received: in the case of packet\n"
1397 "protocols, if a packet larger than this limit is encountered\n"
1399 "will be irrevocably lost.\n\n"
1400 "The optional @var{flags} argument is a value or\n"
1401 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1402 "The value returned is the number of bytes read from the\n"
1404 "Note that the data is read directly from the socket file\n"
1406 "any unread buffered port data is ignored.")
1407 #define FUNC_NAME s_scm_recv
1411 SCM_VALIDATE_OPFPORT (1, sock
);
1413 if (SCM_UNBNDP (flags
))
1416 flg
= scm_to_int (flags
);
1417 fd
= SCM_FPORT_FDES (sock
);
1419 #if SCM_ENABLE_DEPRECATED == 1
1420 if (SCM_UNLIKELY (scm_is_string (buf
)))
1426 scm_c_issue_deprecation_warning
1427 ("Passing a string to `recv!' is deprecated, "
1428 "use a bytevector instead.");
1430 len
= scm_i_string_length (buf
);
1431 msg
= scm_i_make_string (len
, &dest
, 0);
1432 SCM_SYSCALL (rv
= recv (fd
, dest
, len
, flg
));
1433 scm_string_copy_x (buf
, scm_from_int (0),
1434 msg
, scm_from_int (0), scm_from_size_t (len
));
1439 SCM_VALIDATE_BYTEVECTOR (1, buf
);
1441 SCM_SYSCALL (rv
= recv (fd
,
1442 SCM_BYTEVECTOR_CONTENTS (buf
),
1443 SCM_BYTEVECTOR_LENGTH (buf
),
1447 if (SCM_UNLIKELY (rv
== -1))
1450 scm_remember_upto_here (buf
);
1451 return scm_from_int (rv
);
1455 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
1456 (SCM sock
, SCM message
, SCM flags
),
1457 "Transmit bytevector @var{message} on socket port @var{sock}.\n"
1458 "@var{sock} must already be bound to a destination address. The\n"
1459 "value returned is the number of bytes transmitted --\n"
1460 "it's possible for\n"
1461 "this to be less than the length of @var{message}\n"
1462 "if the socket is\n"
1463 "set to be non-blocking. The optional @var{flags} argument\n"
1465 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1466 "Note that the data is written directly to the socket\n"
1467 "file descriptor:\n"
1468 "any unflushed buffered port data is ignored.\n\n"
1469 "This operation is defined only for strings containing codepoints\n"
1471 #define FUNC_NAME s_scm_send
1475 sock
= SCM_COERCE_OUTPORT (sock
);
1476 SCM_VALIDATE_OPFPORT (1, sock
);
1478 if (SCM_UNBNDP (flags
))
1481 flg
= scm_to_int (flags
);
1483 fd
= SCM_FPORT_FDES (sock
);
1485 #if SCM_ENABLE_DEPRECATED == 1
1486 if (SCM_UNLIKELY (scm_is_string (message
)))
1488 scm_c_issue_deprecation_warning
1489 ("Passing a string to `send' is deprecated, "
1490 "use a bytevector instead.");
1492 /* If the string is wide, see if it can be coerced into a narrow
1494 if (!scm_i_is_narrow_string (message
)
1495 || !scm_i_try_narrow_string (message
))
1496 SCM_MISC_ERROR ("the message string is not 8-bit: ~s",
1497 scm_list_1 (message
));
1499 SCM_SYSCALL (rv
= send (fd
,
1500 scm_i_string_chars (message
),
1501 scm_i_string_length (message
),
1507 SCM_VALIDATE_BYTEVECTOR (1, message
);
1509 SCM_SYSCALL (rv
= send (fd
,
1510 SCM_BYTEVECTOR_CONTENTS (message
),
1511 SCM_BYTEVECTOR_LENGTH (message
),
1518 scm_remember_upto_here_1 (message
);
1519 return scm_from_int (rv
);
1523 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
1524 (SCM sock
, SCM buf
, SCM flags
, SCM start
, SCM end
),
1525 "Receive data from socket port @var{sock} (which must be already\n"
1526 "bound), returning the originating address as well as the data.\n"
1527 "This is usually for use on datagram sockets, but can be used on\n"
1528 "stream-oriented sockets too.\n"
1530 "The data received is stored in bytevector @var{buf}, using\n"
1531 "either the whole bytevector or just the region between the optional\n"
1532 "@var{start} and @var{end} positions. The size of @var{buf}\n"
1533 "limits the amount of data that can be received. For datagram\n"
1534 "protocols, if a packet larger than this is received then excess\n"
1535 "bytes are irrevocably lost.\n"
1537 "The return value is a pair. The @code{car} is the number of\n"
1538 "bytes read. The @code{cdr} is a socket address object which is\n"
1539 "where the data came from, or @code{#f} if the origin is\n"
1542 "The optional @var{flags} argument is a or bitwise OR\n"
1543 "(@code{logior}) of @code{MSG_OOB}, @code{MSG_PEEK},\n"
1544 "@code{MSG_DONTROUTE} etc.\n"
1546 "Data is read directly from the socket file descriptor, any\n"
1547 "buffered port data is ignored.\n"
1549 "On a GNU/Linux system @code{recvfrom!} is not multi-threading,\n"
1550 "all threads stop while a @code{recvfrom!} call is in progress.\n"
1551 "An application may need to use @code{select}, @code{O_NONBLOCK}\n"
1552 "or @code{MSG_DONTWAIT} to avoid this.")
1553 #define FUNC_NAME s_scm_recvfrom
1557 size_t offset
, cend
;
1558 socklen_t addr_size
= MAX_ADDR_SIZE
;
1559 scm_t_max_sockaddr addr
;
1561 SCM_VALIDATE_OPFPORT (1, sock
);
1562 fd
= SCM_FPORT_FDES (sock
);
1564 if (SCM_UNBNDP (flags
))
1567 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
1569 ((struct sockaddr
*) &addr
)->sa_family
= AF_UNSPEC
;
1571 #if SCM_ENABLE_DEPRECATED == 1
1572 if (SCM_UNLIKELY (scm_is_string (buf
)))
1576 scm_c_issue_deprecation_warning
1577 ("Passing a string to `recvfrom!' is deprecated, "
1578 "use a bytevector instead.");
1580 scm_i_get_substring_spec (scm_i_string_length (buf
),
1581 start
, &offset
, end
, &cend
);
1583 buf
= scm_i_string_start_writing (buf
);
1584 cbuf
= scm_i_string_writable_chars (buf
);
1586 SCM_SYSCALL (rv
= recvfrom (fd
, cbuf
+ offset
,
1588 (struct sockaddr
*) &addr
, &addr_size
));
1589 scm_i_string_stop_writing ();
1594 SCM_VALIDATE_BYTEVECTOR (1, buf
);
1596 if (SCM_UNBNDP (start
))
1599 offset
= scm_to_size_t (start
);
1601 if (SCM_UNBNDP (end
))
1602 cend
= SCM_BYTEVECTOR_LENGTH (buf
);
1605 cend
= scm_to_size_t (end
);
1606 if (SCM_UNLIKELY (cend
>= SCM_BYTEVECTOR_LENGTH (buf
)
1608 scm_out_of_range (FUNC_NAME
, end
);
1611 SCM_SYSCALL (rv
= recvfrom (fd
,
1612 SCM_BYTEVECTOR_CONTENTS (buf
) + offset
,
1614 (struct sockaddr
*) &addr
, &addr_size
));
1620 /* `recvfrom' does not necessarily return an address. Usually nothing
1621 is returned for stream sockets. */
1622 if (((struct sockaddr
*) &addr
)->sa_family
!= AF_UNSPEC
)
1623 address
= _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1625 address
= SCM_BOOL_F
;
1627 scm_remember_upto_here_1 (buf
);
1629 return scm_cons (scm_from_int (rv
), address
);
1633 SCM_DEFINE (scm_sendto
, "sendto", 3, 1, 1,
1634 (SCM sock
, SCM message
, SCM fam_or_sockaddr
, SCM address
, SCM args_and_flags
),
1635 "Transmit bytevector @var{message} on socket port\n"
1637 "destination address is specified using the @var{fam_or_sockaddr},\n"
1638 "@var{address} and\n"
1639 "@var{args_and_flags} arguments, or just a socket address object "
1640 "returned by @code{make-socket-address}, in a similar way to the\n"
1641 "@code{connect} procedure. @var{args_and_flags} contains\n"
1642 "the usual connection arguments optionally followed by\n"
1643 "a flags argument, which is a value or\n"
1644 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1645 "The value returned is the number of bytes transmitted --\n"
1646 "it's possible for\n"
1647 "this to be less than the length of @var{message} if the\n"
1649 "set to be non-blocking.\n"
1650 "Note that the data is written directly to the socket\n"
1651 "file descriptor:\n"
1652 "any unflushed buffered port data is ignored.\n"
1653 "This operation is defined only for strings containing codepoints\n"
1655 #define FUNC_NAME s_scm_sendto
1658 struct sockaddr
*soka
;
1661 sock
= SCM_COERCE_OUTPORT (sock
);
1662 SCM_VALIDATE_FPORT (1, sock
);
1663 fd
= SCM_FPORT_FDES (sock
);
1665 if (!scm_is_number (fam_or_sockaddr
))
1667 /* FAM_OR_SOCKADDR must actually be a `socket address' object. This
1668 means that the following arguments, i.e. ADDRESS and those listed in
1669 ARGS_AND_FLAGS, are the `MSG_' flags. */
1670 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
1671 if (!scm_is_eq (address
, SCM_UNDEFINED
))
1672 args_and_flags
= scm_cons (address
, args_and_flags
);
1675 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
1676 &args_and_flags
, 3, FUNC_NAME
, &size
);
1678 if (scm_is_null (args_and_flags
))
1682 SCM_VALIDATE_CONS (5, args_and_flags
);
1683 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
1686 #if SCM_ENABLE_DEPRECATED == 1
1687 if (SCM_UNLIKELY (scm_is_string (message
)))
1689 scm_c_issue_deprecation_warning
1690 ("Passing a string to `sendto' is deprecated, "
1691 "use a bytevector instead.");
1693 /* If the string is wide, see if it can be coerced into a narrow
1695 if (!scm_i_is_narrow_string (message
)
1696 || !scm_i_try_narrow_string (message
))
1697 SCM_MISC_ERROR ("the message string is not 8-bit: ~s",
1698 scm_list_1 (message
));
1700 SCM_SYSCALL (rv
= sendto (fd
,
1701 scm_i_string_chars (message
),
1702 scm_i_string_length (message
),
1708 SCM_VALIDATE_BYTEVECTOR (1, message
);
1710 SCM_SYSCALL (rv
= sendto (fd
,
1711 SCM_BYTEVECTOR_CONTENTS (message
),
1712 SCM_BYTEVECTOR_LENGTH (message
),
1718 int save_errno
= errno
;
1725 scm_remember_upto_here_1 (message
);
1726 return scm_from_int (rv
);
1735 /* protocol families. */
1737 scm_c_define ("AF_UNSPEC", scm_from_int (AF_UNSPEC
));
1739 #if defined HAVE_UNIX_DOMAIN_SOCKETS && defined AF_UNIX
1740 scm_c_define ("AF_UNIX", scm_from_int (AF_UNIX
));
1743 scm_c_define ("AF_INET", scm_from_int (AF_INET
));
1746 scm_c_define ("AF_INET6", scm_from_int (AF_INET6
));
1750 scm_c_define ("PF_UNSPEC", scm_from_int (PF_UNSPEC
));
1753 scm_c_define ("PF_UNIX", scm_from_int (PF_UNIX
));
1756 scm_c_define ("PF_INET", scm_from_int (PF_INET
));
1759 scm_c_define ("PF_INET6", scm_from_int (PF_INET6
));
1762 /* standard addresses. */
1764 scm_c_define ("INADDR_ANY", scm_from_ulong (INADDR_ANY
));
1766 #ifdef INADDR_BROADCAST
1767 scm_c_define ("INADDR_BROADCAST", scm_from_ulong (INADDR_BROADCAST
));
1770 scm_c_define ("INADDR_NONE", scm_from_ulong (INADDR_NONE
));
1772 #ifdef INADDR_LOOPBACK
1773 scm_c_define ("INADDR_LOOPBACK", scm_from_ulong (INADDR_LOOPBACK
));
1778 SOCK_PACKET is deliberately omitted, the GNU/Linux socket(2) and
1779 packet(7) advise that it's obsolete and strongly deprecated. */
1782 scm_c_define ("SOCK_STREAM", scm_from_int (SOCK_STREAM
));
1785 scm_c_define ("SOCK_DGRAM", scm_from_int (SOCK_DGRAM
));
1787 #ifdef SOCK_SEQPACKET
1788 scm_c_define ("SOCK_SEQPACKET", scm_from_int (SOCK_SEQPACKET
));
1791 scm_c_define ("SOCK_RAW", scm_from_int (SOCK_RAW
));
1794 scm_c_define ("SOCK_RDM", scm_from_int (SOCK_RDM
));
1797 /* setsockopt level.
1799 SOL_IP, SOL_TCP and SOL_UDP are defined on gnu/linux, but not on for
1800 instance NetBSD. We define IPPROTOs because that's what the posix spec
1801 shows in its example at
1803 http://www.opengroup.org/onlinepubs/007904975/functions/getsockopt.html
1806 scm_c_define ("SOL_SOCKET", scm_from_int (SOL_SOCKET
));
1809 scm_c_define ("IPPROTO_IP", scm_from_int (IPPROTO_IP
));
1812 scm_c_define ("IPPROTO_TCP", scm_from_int (IPPROTO_TCP
));
1815 scm_c_define ("IPPROTO_UDP", scm_from_int (IPPROTO_UDP
));
1818 /* setsockopt names. */
1820 scm_c_define ("SO_DEBUG", scm_from_int (SO_DEBUG
));
1823 scm_c_define ("SO_REUSEADDR", scm_from_int (SO_REUSEADDR
));
1826 scm_c_define ("SO_STYLE", scm_from_int (SO_STYLE
));
1829 scm_c_define ("SO_TYPE", scm_from_int (SO_TYPE
));
1832 scm_c_define ("SO_ERROR", scm_from_int (SO_ERROR
));
1835 scm_c_define ("SO_DONTROUTE", scm_from_int (SO_DONTROUTE
));
1838 scm_c_define ("SO_BROADCAST", scm_from_int (SO_BROADCAST
));
1841 scm_c_define ("SO_SNDBUF", scm_from_int (SO_SNDBUF
));
1844 scm_c_define ("SO_RCVBUF", scm_from_int (SO_RCVBUF
));
1847 scm_c_define ("SO_KEEPALIVE", scm_from_int (SO_KEEPALIVE
));
1850 scm_c_define ("SO_OOBINLINE", scm_from_int (SO_OOBINLINE
));
1853 scm_c_define ("SO_NO_CHECK", scm_from_int (SO_NO_CHECK
));
1856 scm_c_define ("SO_PRIORITY", scm_from_int (SO_PRIORITY
));
1859 scm_c_define ("SO_LINGER", scm_from_int (SO_LINGER
));
1861 #ifdef SO_REUSEPORT /* new in Linux 3.9 */
1862 scm_c_define ("SO_REUSEPORT", scm_from_int (SO_REUSEPORT
));
1865 /* recv/send options. */
1867 scm_c_define ("MSG_DONTWAIT", scm_from_int (MSG_DONTWAIT
));
1870 scm_c_define ("MSG_OOB", scm_from_int (MSG_OOB
));
1873 scm_c_define ("MSG_PEEK", scm_from_int (MSG_PEEK
));
1875 #ifdef MSG_DONTROUTE
1876 scm_c_define ("MSG_DONTROUTE", scm_from_int (MSG_DONTROUTE
));
1879 #ifdef IP_ADD_MEMBERSHIP
1880 scm_c_define ("IP_ADD_MEMBERSHIP", scm_from_int (IP_ADD_MEMBERSHIP
));
1881 scm_c_define ("IP_DROP_MEMBERSHIP", scm_from_int (IP_DROP_MEMBERSHIP
));
1884 #ifdef IP_MULTICAST_TTL
1885 scm_c_define ("IP_MULTICAST_TTL", scm_from_int ( IP_MULTICAST_TTL
));
1888 #ifdef IP_MULTICAST_IF
1889 scm_c_define ("IP_MULTICAST_IF", scm_from_int ( IP_MULTICAST_IF
));
1892 scm_add_feature ("socket");
1894 #include "libguile/socket.x"