1 /* Copyright (C) 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005,
2 * 2006, 2007, 2009, 2011 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
30 #include "libguile/_scm.h"
31 #include "libguile/arrays.h"
32 #include "libguile/feature.h"
33 #include "libguile/fports.h"
34 #include "libguile/strings.h"
35 #include "libguile/vectors.h"
36 #include "libguile/dynwind.h"
37 #include "libguile/srfi-13.h"
39 #include "libguile/validate.h"
40 #include "libguile/socket.h"
43 #include "win32-socket.h"
56 #include <sys/types.h>
57 #ifdef HAVE_WINSOCK2_H
60 #include <sys/socket.h>
61 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
64 #include <netinet/in.h>
66 #include <arpa/inet.h>
69 #if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
70 #define SUN_LEN(ptr) ((size_t) (((struct sockaddr_un *) 0)->sun_path) \
71 + strlen ((ptr)->sun_path))
74 /* The largest possible socket address. Wrapping it in a union guarantees
75 that the compiler will make it suitably aligned. */
78 struct sockaddr sockaddr
;
79 struct sockaddr_in sockaddr_in
;
81 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
82 struct sockaddr_un sockaddr_un
;
85 struct sockaddr_in6 sockaddr_in6
;
90 /* Maximum size of a socket address. */
91 #define MAX_ADDR_SIZE (sizeof (scm_t_max_sockaddr))
96 SCM_DEFINE (scm_htons
, "htons", 1, 0, 0,
98 "Convert a 16 bit quantity from host to network byte ordering.\n"
99 "@var{value} is packed into 2 bytes, which are then converted\n"
100 "and returned as a new integer.")
101 #define FUNC_NAME s_scm_htons
103 return scm_from_ushort (htons (scm_to_ushort (value
)));
107 SCM_DEFINE (scm_ntohs
, "ntohs", 1, 0, 0,
109 "Convert a 16 bit quantity from network to host byte ordering.\n"
110 "@var{value} is packed into 2 bytes, which are then converted\n"
111 "and returned as a new integer.")
112 #define FUNC_NAME s_scm_ntohs
114 return scm_from_ushort (ntohs (scm_to_ushort (value
)));
118 SCM_DEFINE (scm_htonl
, "htonl", 1, 0, 0,
120 "Convert a 32 bit quantity from host to network byte ordering.\n"
121 "@var{value} is packed into 4 bytes, which are then converted\n"
122 "and returned as a new integer.")
123 #define FUNC_NAME s_scm_htonl
125 return scm_from_ulong (htonl (scm_to_uint32 (value
)));
129 SCM_DEFINE (scm_ntohl
, "ntohl", 1, 0, 0,
131 "Convert a 32 bit quantity from network to host byte ordering.\n"
132 "@var{value} is packed into 4 bytes, which are then converted\n"
133 "and returned as a new integer.")
134 #define FUNC_NAME s_scm_ntohl
136 return scm_from_ulong (ntohl (scm_to_uint32 (value
)));
140 #ifdef HAVE_INET_NETOF
141 SCM_DEFINE (scm_inet_netof
, "inet-netof", 1, 0, 0,
143 "Return the network number part of the given IPv4\n"
144 "Internet address. E.g.,\n\n"
146 "(inet-netof 2130706433) @result{} 127\n"
148 #define FUNC_NAME s_scm_inet_netof
151 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
152 return scm_from_ulong (inet_netof (addr
));
157 #ifdef HAVE_INET_LNAOF
158 SCM_DEFINE (scm_lnaof
, "inet-lnaof", 1, 0, 0,
160 "Return the local-address-with-network part of the given\n"
161 "IPv4 Internet address, using the obsolete class A/B/C system.\n"
164 "(inet-lnaof 2130706433) @result{} 1\n"
166 #define FUNC_NAME s_scm_lnaof
169 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
170 return scm_from_ulong (inet_lnaof (addr
));
175 #ifdef HAVE_INET_MAKEADDR
176 SCM_DEFINE (scm_inet_makeaddr
, "inet-makeaddr", 2, 0, 0,
178 "Make an IPv4 Internet address by combining the network number\n"
179 "@var{net} with the local-address-within-network number\n"
180 "@var{lna}. E.g.,\n\n"
182 "(inet-makeaddr 127 1) @result{} 2130706433\n"
184 #define FUNC_NAME s_scm_inet_makeaddr
187 unsigned long netnum
;
188 unsigned long lnanum
;
190 netnum
= SCM_NUM2ULONG (1, net
);
191 lnanum
= SCM_NUM2ULONG (2, lna
);
192 addr
= inet_makeaddr (netnum
, lnanum
);
193 return scm_from_ulong (ntohl (addr
.s_addr
));
200 /* flip a 128 bit IPv6 address between host and network order. */
201 #ifdef WORDS_BIGENDIAN
202 #define FLIP_NET_HOST_128(addr)
204 #define FLIP_NET_HOST_128(addr)\
208 for (i = 0; i < 8; i++)\
210 scm_t_uint8 c = (addr)[i];\
212 (addr)[i] = (addr)[15 - i];\
218 #ifdef WORDS_BIGENDIAN
219 #define FLIPCPY_NET_HOST_128(dest, src) memcpy (dest, src, 16)
221 #define FLIPCPY_NET_HOST_128(dest, src) \
223 const scm_t_uint8 *tmp_srcp = (src) + 15; \
224 scm_t_uint8 *tmp_destp = (dest); \
227 *tmp_destp++ = *tmp_srcp--; \
228 } while (tmp_srcp != (src)); \
233 #if (SIZEOF_SCM_T_BITS * SCM_CHAR_BIT) > 128
234 #error "Assumption that scm_t_bits <= 128 bits has been violated."
237 #if (SIZEOF_UNSIGNED_LONG * SCM_CHAR_BIT) > 128
238 #error "Assumption that unsigned long <= 128 bits has been violated."
241 #if (SIZEOF_UNSIGNED_LONG_LONG * SCM_CHAR_BIT) > 128
242 #error "Assumption that unsigned long long <= 128 bits has been violated."
245 /* convert a 128 bit IPv6 address in network order to a host ordered
248 scm_from_ipv6 (const scm_t_uint8
*src
)
250 SCM result
= scm_i_mkbig ();
251 mpz_import (SCM_I_BIG_MPZ (result
),
253 1, /* big-endian chunk ordering */
254 16, /* chunks are 16 bytes long */
255 1, /* big-endian byte ordering */
256 0, /* "nails" -- leading unused bits per chunk */
258 return scm_i_normbig (result
);
261 /* convert a host ordered SCM integer to a 128 bit IPv6 address in
264 scm_to_ipv6 (scm_t_uint8 dst
[16], SCM src
)
266 if (SCM_I_INUMP (src
))
268 scm_t_signed_bits n
= SCM_I_INUM (src
);
270 scm_out_of_range (NULL
, src
);
271 #ifdef WORDS_BIGENDIAN
272 memset (dst
, 0, 16 - sizeof (scm_t_signed_bits
));
273 memcpy (dst
+ (16 - sizeof (scm_t_signed_bits
)),
275 sizeof (scm_t_signed_bits
));
277 memset (dst
+ sizeof (scm_t_signed_bits
),
279 16 - sizeof (scm_t_signed_bits
));
280 /* FIXME: this pair of ops is kinda wasteful -- should rewrite as
281 a single loop perhaps, similar to the handling of bignums. */
282 memcpy (dst
, &n
, sizeof (scm_t_signed_bits
));
283 FLIP_NET_HOST_128 (dst
);
286 else if (SCM_BIGP (src
))
290 if ((mpz_sgn (SCM_I_BIG_MPZ (src
)) < 0)
291 || mpz_sizeinbase (SCM_I_BIG_MPZ (src
), 2) > 128)
292 scm_out_of_range (NULL
, src
);
297 1, /* big-endian chunk ordering */
298 16, /* chunks are 16 bytes long */
299 1, /* big-endian byte ordering */
300 0, /* "nails" -- leading unused bits per chunk */
301 SCM_I_BIG_MPZ (src
));
302 scm_remember_upto_here_1 (src
);
305 scm_wrong_type_arg_msg ("scm_to_ipv6", 0, src
, "integer");
308 #endif /* HAVE_IPV6 */
312 SCM_DEFINE (scm_inet_ntop
, "inet-ntop", 2, 0, 0,
313 (SCM family
, SCM address
),
314 "Convert a network address into a printable string.\n"
315 "Note that unlike the C version of this function,\n"
316 "the input is an integer with normal host byte ordering.\n"
317 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
319 "(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
320 "(inet-ntop AF_INET6 (- (expt 2 128) 1))\n"
321 " @result{} \"ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\"\n"
323 #define FUNC_NAME s_scm_inet_ntop
326 #ifdef INET6_ADDRSTRLEN
327 char dst
[INET6_ADDRSTRLEN
];
333 af
= scm_to_int (family
);
334 SCM_ASSERT_RANGE (1, family
,
344 addr4
= htonl (SCM_NUM2ULONG (2, address
));
345 result
= inet_ntop (af
, &addr4
, dst
, sizeof (dst
));
348 else if (af
== AF_INET6
)
352 scm_to_ipv6 ((scm_t_uint8
*) addr6
, address
);
353 result
= inet_ntop (af
, &addr6
, dst
, sizeof (dst
));
357 SCM_MISC_ERROR ("unsupported address family", family
);
362 return scm_from_locale_string (dst
);
366 SCM_DEFINE (scm_inet_pton
, "inet-pton", 2, 0, 0,
367 (SCM family
, SCM address
),
368 "Convert a string containing a printable network address to\n"
369 "an integer address. Note that unlike the C version of this\n"
371 "the result is an integer with normal host byte ordering.\n"
372 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
374 "(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
375 "(inet-pton AF_INET6 \"::1\") @result{} 1\n"
377 #define FUNC_NAME s_scm_inet_pton
384 af
= scm_to_int (family
);
385 SCM_ASSERT_RANGE (1, family
,
392 src
= scm_to_locale_string (address
);
393 rv
= inet_pton (af
, src
, dst
);
401 SCM_MISC_ERROR ("Bad address", SCM_EOL
);
403 return scm_from_ulong (ntohl (*dst
));
405 else if (af
== AF_INET6
)
406 return scm_from_ipv6 ((scm_t_uint8
*) dst
);
409 SCM_MISC_ERROR ("unsupported address family", family
);
414 SCM_SYMBOL (sym_socket
, "socket");
416 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
418 SCM_DEFINE (scm_socket
, "socket", 3, 0, 0,
419 (SCM family
, SCM style
, SCM proto
),
420 "Return a new socket port of the type specified by @var{family},\n"
421 "@var{style} and @var{proto}. All three parameters are\n"
422 "integers. Supported values for @var{family} are\n"
423 "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
424 "Typical values for @var{style} are @code{SOCK_STREAM},\n"
425 "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
426 "@var{proto} can be obtained from a protocol name using\n"
427 "@code{getprotobyname}. A value of zero specifies the default\n"
428 "protocol, which is usually right.\n\n"
429 "A single socket port cannot by used for communication until it\n"
430 "has been connected to another socket.")
431 #define FUNC_NAME s_scm_socket
435 fd
= socket (scm_to_int (family
),
440 return SCM_SOCK_FD_TO_PORT (fd
);
444 #ifdef HAVE_SOCKETPAIR
445 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
446 (SCM family
, SCM style
, SCM proto
),
447 "Return a pair of connected (but unnamed) socket ports of the\n"
448 "type specified by @var{family}, @var{style} and @var{proto}.\n"
449 "Many systems support only socket pairs of the @code{AF_UNIX}\n"
450 "family. Zero is likely to be the only meaningful value for\n"
452 #define FUNC_NAME s_scm_socketpair
457 fam
= scm_to_int (family
);
459 if (socketpair (fam
, scm_to_int (style
), scm_to_int (proto
), fd
) == -1)
462 return scm_cons (SCM_SOCK_FD_TO_PORT (fd
[0]), SCM_SOCK_FD_TO_PORT (fd
[1]));
467 /* Possible results for `getsockopt ()'. Wrapping it into a union guarantees
468 suitable alignment. */
471 #ifdef HAVE_STRUCT_LINGER
472 struct linger linger
;
476 } scm_t_getsockopt_result
;
478 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
479 (SCM sock
, SCM level
, SCM optname
),
480 "Return an option value from socket port @var{sock}.\n"
482 "@var{level} is an integer specifying a protocol layer, either\n"
483 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
484 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
485 "(@pxref{Network Databases}).\n"
487 "@defvar SOL_SOCKET\n"
488 "@defvarx IPPROTO_IP\n"
489 "@defvarx IPPROTO_TCP\n"
490 "@defvarx IPPROTO_UDP\n"
493 "@var{optname} is an integer specifying an option within the\n"
496 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
497 "defined (when provided by the system). For their meaning see\n"
498 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
499 "Manual}, or @command{man 7 socket}.\n"
502 "@defvarx SO_REUSEADDR\n"
503 "@defvarx SO_STYLE\n"
505 "@defvarx SO_ERROR\n"
506 "@defvarx SO_DONTROUTE\n"
507 "@defvarx SO_BROADCAST\n"
508 "@defvarx SO_SNDBUF\n"
509 "@defvarx SO_RCVBUF\n"
510 "@defvarx SO_KEEPALIVE\n"
511 "@defvarx SO_OOBINLINE\n"
512 "@defvarx SO_NO_CHECK\n"
513 "@defvarx SO_PRIORITY\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 "@var{value} is an integer.\n"
615 "@defvar SO_LINGER\n"
616 "@var{value} is a pair of integers @code{(@var{ENABLE}\n"
617 ". @var{TIMEOUT})}. On old systems without timeout support\n"
618 "(ie.@: without @code{struct linger}), only @var{ENABLE} has an\n"
619 "effect but the value in Guile is always a pair.\n"
622 "@c Note that we refer only to ``man ip'' here. On GNU/Linux it's\n"
623 "@c ``man 7 ip'' but on NetBSD it's ``man 4 ip''.\n"
625 "For IP level (@code{IPPROTO_IP}) the following @var{optname}s\n"
626 "are defined (when provided by the system). See @command{man\n"
627 "ip} for what they mean.\n"
629 "@defvar IP_MULTICAST_IF\n"
630 "This sets the source interface used by multicast traffic.\n"
633 "@defvar IP_MULTICAST_TTL\n"
634 "This sets the default TTL for multicast traffic. This defaults \n"
635 "to 1 and should be increased to allow traffic to pass beyond the\n"
639 "@defvar IP_ADD_MEMBERSHIP\n"
640 "@defvarx IP_DROP_MEMBERSHIP\n"
641 "These can be used only with @code{setsockopt}, not\n"
642 "@code{getsockopt}. @var{value} is a pair\n"
643 "@code{(@var{MULTIADDR} . @var{INTERFACEADDR})} of IPv4\n"
644 "addresses (@pxref{Network Address Conversion}).\n"
645 "@var{MULTIADDR} is a multicast address to be added to or\n"
646 "dropped from the interface @var{INTERFACEADDR}.\n"
647 "@var{INTERFACEADDR} can be @code{INADDR_ANY} to have the system\n"
648 "select the interface. @var{INTERFACEADDR} can also be an\n"
649 "interface index number, on systems supporting that.\n"
651 #define FUNC_NAME s_scm_setsockopt
656 #ifdef HAVE_STRUCT_LINGER
657 struct linger opt_linger
;
660 #ifdef HAVE_STRUCT_IP_MREQ
661 struct ip_mreq opt_mreq
;
664 const void *optval
= NULL
;
665 socklen_t optlen
= 0;
667 int ilevel
, ioptname
;
669 sock
= SCM_COERCE_OUTPORT (sock
);
671 SCM_VALIDATE_OPFPORT (1, sock
);
672 ilevel
= scm_to_int (level
);
673 ioptname
= scm_to_int (optname
);
675 fd
= SCM_FPORT_FDES (sock
);
677 if (ilevel
== SOL_SOCKET
)
680 if (ioptname
== SO_LINGER
)
682 #ifdef HAVE_STRUCT_LINGER
683 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
684 opt_linger
.l_onoff
= scm_to_int (SCM_CAR (value
));
685 opt_linger
.l_linger
= scm_to_int (SCM_CDR (value
));
686 optlen
= sizeof (struct linger
);
687 optval
= &opt_linger
;
689 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
690 opt_int
= scm_to_int (SCM_CAR (value
));
691 /* timeout is ignored, but may as well validate it. */
692 scm_to_int (SCM_CDR (value
));
693 optlen
= sizeof (int);
701 || ioptname
== SO_SNDBUF
704 || ioptname
== SO_RCVBUF
708 opt_int
= scm_to_int (value
);
709 optlen
= sizeof (size_t);
714 #ifdef HAVE_STRUCT_IP_MREQ
715 if (ilevel
== IPPROTO_IP
&&
716 (ioptname
== IP_ADD_MEMBERSHIP
|| ioptname
== IP_DROP_MEMBERSHIP
))
718 /* Fourth argument must be a pair of addresses. */
719 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
720 opt_mreq
.imr_multiaddr
.s_addr
= htonl (scm_to_ulong (SCM_CAR (value
)));
721 opt_mreq
.imr_interface
.s_addr
= htonl (scm_to_ulong (SCM_CDR (value
)));
722 optlen
= sizeof (opt_mreq
);
729 /* Most options take an int. */
730 opt_int
= scm_to_int (value
);
731 optlen
= sizeof (int);
735 if (setsockopt (fd
, ilevel
, ioptname
, optval
, optlen
) == -1)
737 return SCM_UNSPECIFIED
;
741 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
743 "Sockets can be closed simply by using @code{close-port}. The\n"
744 "@code{shutdown} procedure allows reception or transmission on a\n"
745 "connection to be shut down individually, according to the parameter\n"
749 "Stop receiving data for this socket. If further data arrives, reject it.\n"
751 "Stop trying to transmit data from this socket. Discard any\n"
752 "data waiting to be sent. Stop looking for acknowledgement of\n"
753 "data already sent; don't retransmit it if it is lost.\n"
755 "Stop both reception and transmission.\n"
757 "The return value is unspecified.")
758 #define FUNC_NAME s_scm_shutdown
761 sock
= SCM_COERCE_OUTPORT (sock
);
762 SCM_VALIDATE_OPFPORT (1, sock
);
763 fd
= SCM_FPORT_FDES (sock
);
764 if (shutdown (fd
, scm_to_signed_integer (how
, 0, 2)) == -1)
766 return SCM_UNSPECIFIED
;
770 /* convert fam/address/args into a sockaddr of the appropriate type.
771 args is modified by removing the arguments actually used.
772 which_arg and proc are used when reporting errors:
773 which_arg is the position of address in the original argument list.
774 proc is the name of the original procedure.
775 size returns the size of the structure allocated. */
777 static struct sockaddr
*
778 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
779 const char *proc
, size_t *size
)
780 #define FUNC_NAME proc
786 struct sockaddr_in
*soka
;
790 SCM_VALIDATE_ULONG_COPY (which_arg
, address
, addr
);
791 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
792 port
= scm_to_int (SCM_CAR (*args
));
793 *args
= SCM_CDR (*args
);
794 soka
= (struct sockaddr_in
*) scm_malloc (sizeof (struct sockaddr_in
));
795 memset (soka
, '\0', sizeof (struct sockaddr_in
));
797 #ifdef HAVE_STRUCT_SOCKADDR_IN_SIN_LEN
798 soka
->sin_len
= sizeof (struct sockaddr_in
);
800 soka
->sin_family
= AF_INET
;
801 soka
->sin_addr
.s_addr
= htonl (addr
);
802 soka
->sin_port
= htons (port
);
803 *size
= sizeof (struct sockaddr_in
);
804 return (struct sockaddr
*) soka
;
811 struct sockaddr_in6
*soka
;
812 unsigned long flowinfo
= 0;
813 unsigned long scope_id
= 0;
815 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
816 port
= scm_to_int (SCM_CAR (*args
));
817 *args
= SCM_CDR (*args
);
818 if (scm_is_pair (*args
))
820 SCM_VALIDATE_ULONG_COPY (which_arg
+ 2, SCM_CAR (*args
), flowinfo
);
821 *args
= SCM_CDR (*args
);
822 if (scm_is_pair (*args
))
824 SCM_VALIDATE_ULONG_COPY (which_arg
+ 3, SCM_CAR (*args
),
826 *args
= SCM_CDR (*args
);
829 soka
= (struct sockaddr_in6
*) scm_malloc (sizeof (struct sockaddr_in6
));
831 #ifdef HAVE_STRUCT_SOCKADDR_IN6_SIN6_LEN
832 soka
->sin6_len
= sizeof (struct sockaddr_in6
);
834 soka
->sin6_family
= AF_INET6
;
835 scm_to_ipv6 (soka
->sin6_addr
.s6_addr
, address
);
836 soka
->sin6_port
= htons (port
);
837 soka
->sin6_flowinfo
= flowinfo
;
838 #ifdef HAVE_SIN6_SCOPE_ID
839 soka
->sin6_scope_id
= scope_id
;
841 *size
= sizeof (struct sockaddr_in6
);
842 return (struct sockaddr
*) soka
;
845 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
848 struct sockaddr_un
*soka
;
852 scm_dynwind_begin (0);
854 c_address
= scm_to_locale_string (address
);
855 scm_dynwind_free (c_address
);
857 /* the static buffer size in sockaddr_un seems to be arbitrary
858 and not necessarily a hard limit. e.g., the glibc manual
859 suggests it may be possible to declare it size 0. let's
860 ignore it. if the O/S doesn't like the size it will cause
861 connect/bind etc., to fail. sun_path is always the last
862 member of the structure. */
863 addr_size
= sizeof (struct sockaddr_un
)
864 + max (0, strlen (c_address
) + 1 - (sizeof soka
->sun_path
));
865 soka
= (struct sockaddr_un
*) scm_malloc (addr_size
);
866 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
867 soka
->sun_family
= AF_UNIX
;
868 strcpy (soka
->sun_path
, c_address
);
869 *size
= SUN_LEN (soka
);
872 return (struct sockaddr
*) soka
;
876 scm_out_of_range (proc
, scm_from_int (fam
));
881 SCM_DEFINE (scm_connect
, "connect", 2, 1, 1,
882 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
883 "Initiate a connection from a socket using a specified address\n"
884 "family to the address\n"
885 "specified by @var{address} and possibly @var{args}.\n"
886 "The format required for @var{address}\n"
887 "and @var{args} depends on the family of the socket.\n\n"
888 "For a socket of family @code{AF_UNIX},\n"
889 "only @var{address} is specified and must be a string with the\n"
890 "filename where the socket is to be created.\n\n"
891 "For a socket of family @code{AF_INET},\n"
892 "@var{address} must be an integer IPv4 host address and\n"
893 "@var{args} must be a single integer port number.\n\n"
894 "For a socket of family @code{AF_INET6},\n"
895 "@var{address} must be an integer IPv6 host address and\n"
896 "@var{args} may be up to three integers:\n"
897 "port [flowinfo] [scope_id],\n"
898 "where flowinfo and scope_id default to zero.\n\n"
899 "Alternatively, the second argument can be a socket address object "
900 "as returned by @code{make-socket-address}, in which case the "
901 "no additional arguments should be passed.\n\n"
902 "The return value is unspecified.")
903 #define FUNC_NAME s_scm_connect
906 struct sockaddr
*soka
;
909 sock
= SCM_COERCE_OUTPORT (sock
);
910 SCM_VALIDATE_OPFPORT (1, sock
);
911 fd
= SCM_FPORT_FDES (sock
);
913 if (scm_is_eq (address
, SCM_UNDEFINED
))
914 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
915 `socket address' object. */
916 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
918 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
919 &args
, 3, FUNC_NAME
, &size
);
921 if (connect (fd
, soka
, size
) == -1)
923 int save_errno
= errno
;
930 return SCM_UNSPECIFIED
;
934 SCM_DEFINE (scm_bind
, "bind", 2, 1, 1,
935 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
936 "Assign an address to the socket port @var{sock}.\n"
937 "Generally this only needs to be done for server sockets,\n"
938 "so they know where to look for incoming connections. A socket\n"
939 "without an address will be assigned one automatically when it\n"
940 "starts communicating.\n\n"
941 "The format of @var{address} and @var{args} depends\n"
942 "on the family of the socket.\n\n"
943 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
944 "is specified and must be a string with the filename where\n"
945 "the socket is to be created.\n\n"
946 "For a socket of family @code{AF_INET}, @var{address}\n"
947 "must be an integer IPv4 address and @var{args}\n"
948 "must be a single integer port number.\n\n"
949 "The values of the following variables can also be used for\n"
951 "@defvar INADDR_ANY\n"
952 "Allow connections from any address.\n"
954 "@defvar INADDR_LOOPBACK\n"
955 "The address of the local host using the loopback device.\n"
957 "@defvar INADDR_BROADCAST\n"
958 "The broadcast address on the local network.\n"
960 "@defvar INADDR_NONE\n"
963 "For a socket of family @code{AF_INET6}, @var{address}\n"
964 "must be an integer IPv6 address and @var{args}\n"
965 "may be up to three integers:\n"
966 "port [flowinfo] [scope_id],\n"
967 "where flowinfo and scope_id default to zero.\n\n"
968 "Alternatively, the second argument can be a socket address object "
969 "as returned by @code{make-socket-address}, in which case the "
970 "no additional arguments should be passed.\n\n"
971 "The return value is unspecified.")
972 #define FUNC_NAME s_scm_bind
974 struct sockaddr
*soka
;
978 sock
= SCM_COERCE_OUTPORT (sock
);
979 SCM_VALIDATE_OPFPORT (1, sock
);
980 fd
= SCM_FPORT_FDES (sock
);
982 if (scm_is_eq (address
, SCM_UNDEFINED
))
983 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
984 `socket address' object. */
985 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
987 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
988 &args
, 3, FUNC_NAME
, &size
);
991 if (bind (fd
, soka
, size
) == -1)
993 int save_errno
= errno
;
1000 return SCM_UNSPECIFIED
;
1004 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
1005 (SCM sock
, SCM backlog
),
1006 "Enable @var{sock} to accept connection\n"
1007 "requests. @var{backlog} is an integer specifying\n"
1008 "the maximum length of the queue for pending connections.\n"
1009 "If the queue fills, new clients will fail to connect until\n"
1010 "the server calls @code{accept} to accept a connection from\n"
1012 "The return value is unspecified.")
1013 #define FUNC_NAME s_scm_listen
1016 sock
= SCM_COERCE_OUTPORT (sock
);
1017 SCM_VALIDATE_OPFPORT (1, sock
);
1018 fd
= SCM_FPORT_FDES (sock
);
1019 if (listen (fd
, scm_to_int (backlog
)) == -1)
1021 return SCM_UNSPECIFIED
;
1025 /* Put the components of a sockaddr into a new SCM vector. */
1026 static SCM_C_INLINE_KEYWORD SCM
1027 _scm_from_sockaddr (const scm_t_max_sockaddr
*address
, unsigned addr_size
,
1030 SCM result
= SCM_EOL
;
1031 short int fam
= ((struct sockaddr
*) address
)->sa_family
;
1037 const struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
1039 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
1041 SCM_SIMPLE_VECTOR_SET(result
, 0,
1042 scm_from_short (fam
));
1043 SCM_SIMPLE_VECTOR_SET(result
, 1,
1044 scm_from_ulong (ntohl (nad
->sin_addr
.s_addr
)));
1045 SCM_SIMPLE_VECTOR_SET(result
, 2,
1046 scm_from_ushort (ntohs (nad
->sin_port
)));
1052 const struct sockaddr_in6
*nad
= (struct sockaddr_in6
*) address
;
1054 result
= scm_c_make_vector (5, SCM_UNSPECIFIED
);
1055 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1056 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_ipv6 (nad
->sin6_addr
.s6_addr
));
1057 SCM_SIMPLE_VECTOR_SET(result
, 2, scm_from_ushort (ntohs (nad
->sin6_port
)));
1058 SCM_SIMPLE_VECTOR_SET(result
, 3, scm_from_uint32 (nad
->sin6_flowinfo
));
1059 #ifdef HAVE_SIN6_SCOPE_ID
1060 SCM_SIMPLE_VECTOR_SET(result
, 4, scm_from_ulong (nad
->sin6_scope_id
));
1062 SCM_SIMPLE_VECTOR_SET(result
, 4, SCM_INUM0
);
1067 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1070 const struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
1072 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
1074 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1075 /* When addr_size is not enough to cover sun_path, do not try
1077 if (addr_size
<= offsetof (struct sockaddr_un
, sun_path
))
1078 SCM_SIMPLE_VECTOR_SET(result
, 1, SCM_BOOL_F
);
1080 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_locale_string (nad
->sun_path
));
1085 result
= SCM_UNSPECIFIED
;
1086 scm_misc_error (proc
, "unrecognised address family: ~A",
1087 scm_list_1 (scm_from_int (fam
)));
1093 /* The publicly-visible function. Return a Scheme object representing
1094 ADDRESS, an address of ADDR_SIZE bytes. */
1096 scm_from_sockaddr (const struct sockaddr
*address
, unsigned addr_size
)
1098 return (_scm_from_sockaddr ((scm_t_max_sockaddr
*) address
,
1099 addr_size
, "scm_from_sockaddr"));
1102 /* Convert ADDRESS, an address object returned by either
1103 `scm_from_sockaddr ()' or `scm_make_socket_address ()', into its C
1104 representation. On success, a non-NULL pointer is returned and
1105 ADDRESS_SIZE is updated to the actual size (in bytes) of the returned
1106 address. The result must eventually be freed using `free ()'. */
1108 scm_to_sockaddr (SCM address
, size_t *address_size
)
1109 #define FUNC_NAME "scm_to_sockaddr"
1112 struct sockaddr
*c_address
= NULL
;
1114 SCM_VALIDATE_VECTOR (1, address
);
1117 family
= scm_to_short (SCM_SIMPLE_VECTOR_REF (address
, 0));
1123 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 3)
1124 scm_misc_error (FUNC_NAME
,
1125 "invalid inet address representation: ~A",
1126 scm_list_1 (address
));
1129 struct sockaddr_in c_inet
;
1131 memset (&c_inet
, '\0', sizeof (struct sockaddr_in
));
1133 #ifdef HAVE_STRUCT_SOCKADDR_IN_SIN_LEN
1134 c_inet
.sin_len
= sizeof (struct sockaddr_in
);
1137 c_inet
.sin_addr
.s_addr
=
1138 htonl (scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 1)));
1140 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1141 c_inet
.sin_family
= AF_INET
;
1143 *address_size
= sizeof (c_inet
);
1144 c_address
= scm_malloc (sizeof (c_inet
));
1145 memcpy (c_address
, &c_inet
, sizeof (c_inet
));
1154 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 5)
1155 scm_misc_error (FUNC_NAME
, "invalid inet6 address representation: ~A",
1156 scm_list_1 (address
));
1159 struct sockaddr_in6 c_inet6
;
1161 scm_to_ipv6 (c_inet6
.sin6_addr
.s6_addr
,
1162 SCM_SIMPLE_VECTOR_REF (address
, 1));
1164 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1165 c_inet6
.sin6_flowinfo
=
1166 scm_to_uint32 (SCM_SIMPLE_VECTOR_REF (address
, 3));
1167 #ifdef HAVE_SIN6_SCOPE_ID
1168 c_inet6
.sin6_scope_id
=
1169 scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 4));
1172 c_inet6
.sin6_family
= AF_INET6
;
1174 *address_size
= sizeof (c_inet6
);
1175 c_address
= scm_malloc (sizeof (c_inet6
));
1176 memcpy (c_address
, &c_inet6
, sizeof (c_inet6
));
1183 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1186 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 2)
1187 scm_misc_error (FUNC_NAME
, "invalid unix address representation: ~A",
1188 scm_list_1 (address
));
1192 size_t path_len
= 0;
1194 path
= SCM_SIMPLE_VECTOR_REF (address
, 1);
1195 if (!scm_is_string (path
) && !scm_is_false (path
))
1196 scm_misc_error (FUNC_NAME
, "invalid unix address "
1197 "path: ~A", scm_list_1 (path
));
1200 struct sockaddr_un c_unix
;
1202 if (scm_is_false (path
))
1205 path_len
= scm_c_string_length (path
);
1207 #ifdef UNIX_PATH_MAX
1208 if (path_len
>= UNIX_PATH_MAX
)
1210 /* We can hope that this limit will eventually vanish, at least on GNU.
1211 However, currently, while glibc doesn't define `UNIX_PATH_MAX', it
1212 documents it has being limited to 108 bytes. */
1213 if (path_len
>= sizeof (c_unix
.sun_path
))
1215 scm_misc_error (FUNC_NAME
, "unix address path "
1216 "too long: ~A", scm_list_1 (path
));
1221 scm_to_locale_stringbuf (path
, c_unix
.sun_path
,
1222 #ifdef UNIX_PATH_MAX
1225 sizeof (c_unix
.sun_path
));
1227 c_unix
.sun_path
[path_len
] = '\0';
1230 if (strlen (c_unix
.sun_path
) != path_len
)
1231 scm_misc_error (FUNC_NAME
, "unix address path "
1232 "contains nul characters: ~A",
1236 c_unix
.sun_path
[0] = '\0';
1238 c_unix
.sun_family
= AF_UNIX
;
1240 *address_size
= SUN_LEN (&c_unix
);
1241 c_address
= scm_malloc (sizeof (c_unix
));
1242 memcpy (c_address
, &c_unix
, sizeof (c_unix
));
1252 scm_misc_error (FUNC_NAME
, "unrecognised address family: ~A",
1253 scm_list_1 (scm_from_ushort (family
)));
1261 /* Return a newly-allocated `sockaddr' structure that reflects ADDRESS, being
1262 an address of family FAMILY, with the family-specific parameters ARGS (see
1263 the description of `connect' for details). The returned structure may be
1264 freed using `free ()'. */
1266 scm_c_make_socket_address (SCM family
, SCM address
, SCM args
,
1267 size_t *address_size
)
1269 struct sockaddr
*soka
;
1271 soka
= scm_fill_sockaddr (scm_to_ushort (family
), address
, &args
, 1,
1272 "scm_c_make_socket_address", address_size
);
1277 SCM_DEFINE (scm_make_socket_address
, "make-socket-address", 2, 0, 1,
1278 (SCM family
, SCM address
, SCM args
),
1279 "Return a Scheme address object that reflects @var{address}, "
1280 "being an address of family @var{family}, with the "
1281 "family-specific parameters @var{args} (see the description of "
1282 "@code{connect} for details).")
1283 #define FUNC_NAME s_scm_make_socket_address
1285 SCM result
= SCM_BOOL_F
;
1286 struct sockaddr
*c_address
;
1287 size_t c_address_size
;
1289 c_address
= scm_c_make_socket_address (family
, address
, args
,
1291 if (c_address
!= NULL
)
1293 result
= scm_from_sockaddr (c_address
, c_address_size
);
1302 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
1304 "Accept a connection on a bound, listening socket.\n"
1306 "are no pending connections in the queue, wait until\n"
1307 "one is available unless the non-blocking option has been\n"
1308 "set on the socket.\n\n"
1309 "The return value is a\n"
1310 "pair in which the @emph{car} is a new socket port for the\n"
1312 "the @emph{cdr} is an object with address information about the\n"
1313 "client which initiated the connection.\n\n"
1314 "@var{sock} does not become part of the\n"
1315 "connection and will continue to accept new requests.")
1316 #define FUNC_NAME s_scm_accept
1322 socklen_t addr_size
= MAX_ADDR_SIZE
;
1323 scm_t_max_sockaddr addr
;
1325 sock
= SCM_COERCE_OUTPORT (sock
);
1326 SCM_VALIDATE_OPFPORT (1, sock
);
1327 fd
= SCM_FPORT_FDES (sock
);
1328 newfd
= accept (fd
, (struct sockaddr
*) &addr
, &addr_size
);
1331 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
1332 address
= _scm_from_sockaddr (&addr
, addr_size
,
1335 return scm_cons (newsock
, address
);
1339 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
1341 "Return the address of @var{sock}, in the same form as the\n"
1342 "object returned by @code{accept}. On many systems the address\n"
1343 "of a socket in the @code{AF_FILE} namespace cannot be read.")
1344 #define FUNC_NAME s_scm_getsockname
1347 socklen_t addr_size
= MAX_ADDR_SIZE
;
1348 scm_t_max_sockaddr addr
;
1350 sock
= SCM_COERCE_OUTPORT (sock
);
1351 SCM_VALIDATE_OPFPORT (1, sock
);
1352 fd
= SCM_FPORT_FDES (sock
);
1353 if (getsockname (fd
, (struct sockaddr
*) &addr
, &addr_size
) == -1)
1356 return _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1360 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
1362 "Return the address that @var{sock}\n"
1363 "is connected to, in the same form as the object returned by\n"
1364 "@code{accept}. On many systems the address of a socket in the\n"
1365 "@code{AF_FILE} namespace cannot be read.")
1366 #define FUNC_NAME s_scm_getpeername
1369 socklen_t addr_size
= MAX_ADDR_SIZE
;
1370 scm_t_max_sockaddr addr
;
1372 sock
= SCM_COERCE_OUTPORT (sock
);
1373 SCM_VALIDATE_OPFPORT (1, sock
);
1374 fd
= SCM_FPORT_FDES (sock
);
1375 if (getpeername (fd
, (struct sockaddr
*) &addr
, &addr_size
) == -1)
1378 return _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1382 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
1383 (SCM sock
, SCM buf
, SCM flags
),
1384 "Receive data from a socket port.\n"
1385 "@var{sock} must already\n"
1386 "be bound to the address from which data is to be received.\n"
1387 "@var{buf} is a bytevector into which\n"
1388 "the data will be written. The size of @var{buf} limits\n"
1390 "data which can be received: in the case of packet\n"
1391 "protocols, if a packet larger than this limit is encountered\n"
1393 "will be irrevocably lost.\n\n"
1394 "The optional @var{flags} argument is a value or\n"
1395 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1396 "The value returned is the number of bytes read from the\n"
1398 "Note that the data is read directly from the socket file\n"
1400 "any unread buffered port data is ignored.")
1401 #define FUNC_NAME s_scm_recv
1405 SCM_VALIDATE_OPFPORT (1, sock
);
1407 if (SCM_UNBNDP (flags
))
1410 flg
= scm_to_int (flags
);
1411 fd
= SCM_FPORT_FDES (sock
);
1413 SCM_VALIDATE_BYTEVECTOR (1, buf
);
1415 SCM_SYSCALL (rv
= recv (fd
,
1416 SCM_BYTEVECTOR_CONTENTS (buf
),
1417 SCM_BYTEVECTOR_LENGTH (buf
),
1420 if (SCM_UNLIKELY (rv
== -1))
1423 scm_remember_upto_here (buf
);
1424 return scm_from_int (rv
);
1428 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
1429 (SCM sock
, SCM message
, SCM flags
),
1430 "Transmit bytevector @var{message} on socket port @var{sock}.\n"
1431 "@var{sock} must already be bound to a destination address. The\n"
1432 "value returned is the number of bytes transmitted --\n"
1433 "it's possible for\n"
1434 "this to be less than the length of @var{message}\n"
1435 "if the socket is\n"
1436 "set to be non-blocking. The optional @var{flags} argument\n"
1438 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1439 "Note that the data is written directly to the socket\n"
1440 "file descriptor:\n"
1441 "any unflushed buffered port data is ignored.\n\n"
1442 "This operation is defined only for strings containing codepoints\n"
1444 #define FUNC_NAME s_scm_send
1448 sock
= SCM_COERCE_OUTPORT (sock
);
1449 SCM_VALIDATE_OPFPORT (1, sock
);
1451 if (SCM_UNBNDP (flags
))
1454 flg
= scm_to_int (flags
);
1456 fd
= SCM_FPORT_FDES (sock
);
1458 SCM_VALIDATE_BYTEVECTOR (1, message
);
1460 SCM_SYSCALL (rv
= send (fd
,
1461 SCM_BYTEVECTOR_CONTENTS (message
),
1462 SCM_BYTEVECTOR_LENGTH (message
),
1468 scm_remember_upto_here_1 (message
);
1469 return scm_from_int (rv
);
1473 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
1474 (SCM sock
, SCM buf
, SCM flags
, SCM start
, SCM end
),
1475 "Receive data from socket port @var{sock} (which must be already\n"
1476 "bound), returning the originating address as well as the data.\n"
1477 "This is usually for use on datagram sockets, but can be used on\n"
1478 "stream-oriented sockets too.\n"
1480 "The data received is stored in bytevector @var{buf}, using\n"
1481 "either the whole bytevector or just the region between the optional\n"
1482 "@var{start} and @var{end} positions. The size of @var{buf}\n"
1483 "limits the amount of data that can be received. For datagram\n"
1484 "protocols, if a packet larger than this is received then excess\n"
1485 "bytes are irrevocably lost.\n"
1487 "The return value is a pair. The @code{car} is the number of\n"
1488 "bytes read. The @code{cdr} is a socket address object which is\n"
1489 "where the data came from, or @code{#f} if the origin is\n"
1492 "The optional @var{flags} argument is a or bitwise OR\n"
1493 "(@code{logior}) of @code{MSG_OOB}, @code{MSG_PEEK},\n"
1494 "@code{MSG_DONTROUTE} etc.\n"
1496 "Data is read directly from the socket file descriptor, any\n"
1497 "buffered port data is ignored.\n"
1499 "On a GNU/Linux system @code{recvfrom!} is not multi-threading,\n"
1500 "all threads stop while a @code{recvfrom!} call is in progress.\n"
1501 "An application may need to use @code{select}, @code{O_NONBLOCK}\n"
1502 "or @code{MSG_DONTWAIT} to avoid this.")
1503 #define FUNC_NAME s_scm_recvfrom
1507 size_t offset
, cend
;
1508 socklen_t addr_size
= MAX_ADDR_SIZE
;
1509 scm_t_max_sockaddr addr
;
1511 SCM_VALIDATE_OPFPORT (1, sock
);
1512 fd
= SCM_FPORT_FDES (sock
);
1514 if (SCM_UNBNDP (flags
))
1517 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
1519 ((struct sockaddr
*) &addr
)->sa_family
= AF_UNSPEC
;
1521 SCM_VALIDATE_BYTEVECTOR (1, buf
);
1523 if (SCM_UNBNDP (start
))
1526 offset
= scm_to_size_t (start
);
1528 if (SCM_UNBNDP (end
))
1529 cend
= SCM_BYTEVECTOR_LENGTH (buf
);
1532 cend
= scm_to_size_t (end
);
1533 if (SCM_UNLIKELY (cend
>= SCM_BYTEVECTOR_LENGTH (buf
)
1535 scm_out_of_range (FUNC_NAME
, end
);
1538 SCM_SYSCALL (rv
= recvfrom (fd
,
1539 SCM_BYTEVECTOR_CONTENTS (buf
) + offset
,
1541 (struct sockaddr
*) &addr
, &addr_size
));
1546 /* `recvfrom' does not necessarily return an address. Usually nothing
1547 is returned for stream sockets. */
1548 if (((struct sockaddr
*) &addr
)->sa_family
!= AF_UNSPEC
)
1549 address
= _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1551 address
= SCM_BOOL_F
;
1553 scm_remember_upto_here_1 (buf
);
1555 return scm_cons (scm_from_int (rv
), address
);
1559 SCM_DEFINE (scm_sendto
, "sendto", 3, 1, 1,
1560 (SCM sock
, SCM message
, SCM fam_or_sockaddr
, SCM address
, SCM args_and_flags
),
1561 "Transmit bytevector @var{message} on socket port\n"
1563 "destination address is specified using the @var{fam_or_sockaddr},\n"
1564 "@var{address} and\n"
1565 "@var{args_and_flags} arguments, or just a socket address object "
1566 "returned by @code{make-socket-address}, in a similar way to the\n"
1567 "@code{connect} procedure. @var{args_and_flags} contains\n"
1568 "the usual connection arguments optionally followed by\n"
1569 "a flags argument, which is a value or\n"
1570 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1571 "The value returned is the number of bytes transmitted --\n"
1572 "it's possible for\n"
1573 "this to be less than the length of @var{message} if the\n"
1575 "set to be non-blocking.\n"
1576 "Note that the data is written directly to the socket\n"
1577 "file descriptor:\n"
1578 "any unflushed buffered port data is ignored.\n"
1579 "This operation is defined only for strings containing codepoints\n"
1581 #define FUNC_NAME s_scm_sendto
1584 struct sockaddr
*soka
;
1587 sock
= SCM_COERCE_OUTPORT (sock
);
1588 SCM_VALIDATE_FPORT (1, sock
);
1589 fd
= SCM_FPORT_FDES (sock
);
1591 if (!scm_is_number (fam_or_sockaddr
))
1593 /* FAM_OR_SOCKADDR must actually be a `socket address' object. This
1594 means that the following arguments, i.e. ADDRESS and those listed in
1595 ARGS_AND_FLAGS, are the `MSG_' flags. */
1596 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
1597 if (!scm_is_eq (address
, SCM_UNDEFINED
))
1598 args_and_flags
= scm_cons (address
, args_and_flags
);
1601 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
1602 &args_and_flags
, 3, FUNC_NAME
, &size
);
1604 if (scm_is_null (args_and_flags
))
1608 SCM_VALIDATE_CONS (5, args_and_flags
);
1609 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
1612 SCM_VALIDATE_BYTEVECTOR (1, message
);
1614 SCM_SYSCALL (rv
= sendto (fd
,
1615 SCM_BYTEVECTOR_CONTENTS (message
),
1616 SCM_BYTEVECTOR_LENGTH (message
),
1621 int save_errno
= errno
;
1628 scm_remember_upto_here_1 (message
);
1629 return scm_from_int (rv
);
1638 /* protocol families. */
1640 scm_c_define ("AF_UNSPEC", scm_from_int (AF_UNSPEC
));
1643 scm_c_define ("AF_UNIX", scm_from_int (AF_UNIX
));
1646 scm_c_define ("AF_INET", scm_from_int (AF_INET
));
1649 scm_c_define ("AF_INET6", scm_from_int (AF_INET6
));
1653 scm_c_define ("PF_UNSPEC", scm_from_int (PF_UNSPEC
));
1656 scm_c_define ("PF_UNIX", scm_from_int (PF_UNIX
));
1659 scm_c_define ("PF_INET", scm_from_int (PF_INET
));
1662 scm_c_define ("PF_INET6", scm_from_int (PF_INET6
));
1665 /* standard addresses. */
1667 scm_c_define ("INADDR_ANY", scm_from_ulong (INADDR_ANY
));
1669 #ifdef INADDR_BROADCAST
1670 scm_c_define ("INADDR_BROADCAST", scm_from_ulong (INADDR_BROADCAST
));
1673 scm_c_define ("INADDR_NONE", scm_from_ulong (INADDR_NONE
));
1675 #ifdef INADDR_LOOPBACK
1676 scm_c_define ("INADDR_LOOPBACK", scm_from_ulong (INADDR_LOOPBACK
));
1681 SOCK_PACKET is deliberately omitted, the GNU/Linux socket(2) and
1682 packet(7) advise that it's obsolete and strongly deprecated. */
1685 scm_c_define ("SOCK_STREAM", scm_from_int (SOCK_STREAM
));
1688 scm_c_define ("SOCK_DGRAM", scm_from_int (SOCK_DGRAM
));
1690 #ifdef SOCK_SEQPACKET
1691 scm_c_define ("SOCK_SEQPACKET", scm_from_int (SOCK_SEQPACKET
));
1694 scm_c_define ("SOCK_RAW", scm_from_int (SOCK_RAW
));
1697 scm_c_define ("SOCK_RDM", scm_from_int (SOCK_RDM
));
1700 /* setsockopt level.
1702 SOL_IP, SOL_TCP and SOL_UDP are defined on gnu/linux, but not on for
1703 instance NetBSD. We define IPPROTOs because that's what the posix spec
1704 shows in its example at
1706 http://www.opengroup.org/onlinepubs/007904975/functions/getsockopt.html
1709 scm_c_define ("SOL_SOCKET", scm_from_int (SOL_SOCKET
));
1712 scm_c_define ("IPPROTO_IP", scm_from_int (IPPROTO_IP
));
1715 scm_c_define ("IPPROTO_TCP", scm_from_int (IPPROTO_TCP
));
1718 scm_c_define ("IPPROTO_UDP", scm_from_int (IPPROTO_UDP
));
1721 /* setsockopt names. */
1723 scm_c_define ("SO_DEBUG", scm_from_int (SO_DEBUG
));
1726 scm_c_define ("SO_REUSEADDR", scm_from_int (SO_REUSEADDR
));
1729 scm_c_define ("SO_STYLE", scm_from_int (SO_STYLE
));
1732 scm_c_define ("SO_TYPE", scm_from_int (SO_TYPE
));
1735 scm_c_define ("SO_ERROR", scm_from_int (SO_ERROR
));
1738 scm_c_define ("SO_DONTROUTE", scm_from_int (SO_DONTROUTE
));
1741 scm_c_define ("SO_BROADCAST", scm_from_int (SO_BROADCAST
));
1744 scm_c_define ("SO_SNDBUF", scm_from_int (SO_SNDBUF
));
1747 scm_c_define ("SO_RCVBUF", scm_from_int (SO_RCVBUF
));
1750 scm_c_define ("SO_KEEPALIVE", scm_from_int (SO_KEEPALIVE
));
1753 scm_c_define ("SO_OOBINLINE", scm_from_int (SO_OOBINLINE
));
1756 scm_c_define ("SO_NO_CHECK", scm_from_int (SO_NO_CHECK
));
1759 scm_c_define ("SO_PRIORITY", scm_from_int (SO_PRIORITY
));
1762 scm_c_define ("SO_LINGER", scm_from_int (SO_LINGER
));
1765 /* recv/send options. */
1767 scm_c_define ("MSG_DONTWAIT", scm_from_int (MSG_DONTWAIT
));
1770 scm_c_define ("MSG_OOB", scm_from_int (MSG_OOB
));
1773 scm_c_define ("MSG_PEEK", scm_from_int (MSG_PEEK
));
1775 #ifdef MSG_DONTROUTE
1776 scm_c_define ("MSG_DONTROUTE", scm_from_int (MSG_DONTROUTE
));
1780 scm_i_init_socket_Win32 ();
1783 #ifdef IP_ADD_MEMBERSHIP
1784 scm_c_define ("IP_ADD_MEMBERSHIP", scm_from_int (IP_ADD_MEMBERSHIP
));
1785 scm_c_define ("IP_DROP_MEMBERSHIP", scm_from_int (IP_DROP_MEMBERSHIP
));
1788 #ifdef IP_MULTICAST_TTL
1789 scm_c_define ("IP_MULTICAST_TTL", scm_from_int ( IP_MULTICAST_TTL
));
1792 #ifdef IP_MULTICAST_IF
1793 scm_c_define ("IP_MULTICAST_IF", scm_from_int ( IP_MULTICAST_IF
));
1796 scm_add_feature ("socket");
1798 #include "libguile/socket.x"