1 /* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 2009 Free Software Foundation, Inc.
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public License
5 * as published by the Free Software Foundation; either version 3 of
6 * the License, or (at your option) any later version.
8 * This library is distributed in the hope that it will be useful, but
9 * WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
29 #include "libguile/_scm.h"
30 #include "libguile/arrays.h"
31 #include "libguile/feature.h"
32 #include "libguile/fports.h"
33 #include "libguile/strings.h"
34 #include "libguile/vectors.h"
35 #include "libguile/dynwind.h"
36 #include "libguile/srfi-13.h"
38 #include "libguile/validate.h"
39 #include "libguile/socket.h"
41 #include "libguile/iselect.h"
44 #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 SCM_DEFINE (scm_inet_pton
, "inet-pton", 2, 0, 0,
309 (SCM family
, SCM address
),
310 "Convert a string containing a printable network address to\n"
311 "an integer address. Note that unlike the C version of this\n"
313 "the result is an integer with normal host byte ordering.\n"
314 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
316 "(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
317 "(inet-pton AF_INET6 \"::1\") @result{} 1\n"
319 #define FUNC_NAME s_scm_inet_pton
326 af
= scm_to_int (family
);
327 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
328 src
= scm_to_locale_string (address
);
329 rv
= inet_pton (af
, src
, dst
);
336 SCM_MISC_ERROR ("Bad address", SCM_EOL
);
338 return scm_from_ulong (ntohl (*dst
));
340 return scm_from_ipv6 ((scm_t_uint8
*) dst
);
344 SCM_DEFINE (scm_inet_ntop
, "inet-ntop", 2, 0, 0,
345 (SCM family
, SCM address
),
346 "Convert a network address into a printable string.\n"
347 "Note that unlike the C version of this function,\n"
348 "the input is an integer with normal host byte ordering.\n"
349 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
351 "(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
352 "(inet-ntop AF_INET6 (- (expt 2 128) 1))\n"
353 " @result{} \"ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\"\n"
355 #define FUNC_NAME s_scm_inet_ntop
358 #ifdef INET6_ADDRSTRLEN
359 char dst
[INET6_ADDRSTRLEN
];
365 af
= scm_to_int (family
);
366 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
371 addr4
= htonl (SCM_NUM2ULONG (2, address
));
372 result
= inet_ntop (af
, &addr4
, dst
, sizeof (dst
));
378 scm_to_ipv6 ((scm_t_uint8
*) addr6
, address
);
379 result
= inet_ntop (af
, &addr6
, dst
, sizeof (dst
));
385 return scm_from_locale_string (dst
);
389 #endif /* HAVE_IPV6 */
391 SCM_SYMBOL (sym_socket
, "socket");
393 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
395 SCM_DEFINE (scm_socket
, "socket", 3, 0, 0,
396 (SCM family
, SCM style
, SCM proto
),
397 "Return a new socket port of the type specified by @var{family},\n"
398 "@var{style} and @var{proto}. All three parameters are\n"
399 "integers. Supported values for @var{family} are\n"
400 "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
401 "Typical values for @var{style} are @code{SOCK_STREAM},\n"
402 "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
403 "@var{proto} can be obtained from a protocol name using\n"
404 "@code{getprotobyname}. A value of zero specifies the default\n"
405 "protocol, which is usually right.\n\n"
406 "A single socket port cannot by used for communication until it\n"
407 "has been connected to another socket.")
408 #define FUNC_NAME s_scm_socket
412 fd
= socket (scm_to_int (family
),
417 return SCM_SOCK_FD_TO_PORT (fd
);
421 #ifdef HAVE_SOCKETPAIR
422 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
423 (SCM family
, SCM style
, SCM proto
),
424 "Return a pair of connected (but unnamed) socket ports of the\n"
425 "type specified by @var{family}, @var{style} and @var{proto}.\n"
426 "Many systems support only socket pairs of the @code{AF_UNIX}\n"
427 "family. Zero is likely to be the only meaningful value for\n"
429 #define FUNC_NAME s_scm_socketpair
434 fam
= scm_to_int (family
);
436 if (socketpair (fam
, scm_to_int (style
), scm_to_int (proto
), fd
) == -1)
439 return scm_cons (SCM_SOCK_FD_TO_PORT (fd
[0]), SCM_SOCK_FD_TO_PORT (fd
[1]));
444 /* Possible results for `getsockopt ()'. Wrapping it into a union guarantees
445 suitable alignment. */
448 #ifdef HAVE_STRUCT_LINGER
449 struct linger linger
;
453 } scm_t_getsockopt_result
;
455 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
456 (SCM sock
, SCM level
, SCM optname
),
457 "Return an option value from socket port @var{sock}.\n"
459 "@var{level} is an integer specifying a protocol layer, either\n"
460 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
461 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
462 "(@pxref{Network Databases}).\n"
464 "@defvar SOL_SOCKET\n"
465 "@defvarx IPPROTO_IP\n"
466 "@defvarx IPPROTO_TCP\n"
467 "@defvarx IPPROTO_UDP\n"
470 "@var{optname} is an integer specifying an option within the\n"
473 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
474 "defined (when provided by the system). For their meaning see\n"
475 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
476 "Manual}, or @command{man 7 socket}.\n"
479 "@defvarx SO_REUSEADDR\n"
480 "@defvarx SO_STYLE\n"
482 "@defvarx SO_ERROR\n"
483 "@defvarx SO_DONTROUTE\n"
484 "@defvarx SO_BROADCAST\n"
485 "@defvarx SO_SNDBUF\n"
486 "@defvarx SO_RCVBUF\n"
487 "@defvarx SO_KEEPALIVE\n"
488 "@defvarx SO_OOBINLINE\n"
489 "@defvarx SO_NO_CHECK\n"
490 "@defvarx SO_PRIORITY\n"
491 "The value returned is an integer.\n"
494 "@defvar SO_LINGER\n"
495 "The @var{value} returned is a pair of integers\n"
496 "@code{(@var{ENABLE} . @var{TIMEOUT})}. On old systems without\n"
497 "timeout support (ie.@: without @code{struct linger}), only\n"
498 "@var{ENABLE} has an effect but the value in Guile is always a\n"
501 #define FUNC_NAME s_scm_getsockopt
504 /* size of optval is the largest supported option. */
505 scm_t_getsockopt_result optval
;
506 socklen_t optlen
= sizeof (optval
);
510 sock
= SCM_COERCE_OUTPORT (sock
);
511 SCM_VALIDATE_OPFPORT (1, sock
);
512 ilevel
= scm_to_int (level
);
513 ioptname
= scm_to_int (optname
);
515 fd
= SCM_FPORT_FDES (sock
);
516 if (getsockopt (fd
, ilevel
, ioptname
, (void *) &optval
, &optlen
) == -1)
519 if (ilevel
== SOL_SOCKET
)
522 if (ioptname
== SO_LINGER
)
524 #ifdef HAVE_STRUCT_LINGER
525 struct linger
*ling
= (struct linger
*) &optval
;
527 return scm_cons (scm_from_long (ling
->l_onoff
),
528 scm_from_long (ling
->l_linger
));
530 return scm_cons (scm_from_long (*(int *) &optval
),
538 || ioptname
== SO_SNDBUF
541 || ioptname
== SO_RCVBUF
545 return scm_from_size_t (*(size_t *) &optval
);
548 return scm_from_int (*(int *) &optval
);
552 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
553 (SCM sock
, SCM level
, SCM optname
, SCM value
),
554 "Set an option on socket port @var{sock}. The return value is\n"
557 "@var{level} is an integer specifying a protocol layer, either\n"
558 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
559 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
560 "(@pxref{Network Databases}).\n"
562 "@defvar SOL_SOCKET\n"
563 "@defvarx IPPROTO_IP\n"
564 "@defvarx IPPROTO_TCP\n"
565 "@defvarx IPPROTO_UDP\n"
568 "@var{optname} is an integer specifying an option within the\n"
571 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
572 "defined (when provided by the system). For their meaning see\n"
573 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
574 "Manual}, or @command{man 7 socket}.\n"
577 "@defvarx SO_REUSEADDR\n"
578 "@defvarx SO_STYLE\n"
580 "@defvarx SO_ERROR\n"
581 "@defvarx SO_DONTROUTE\n"
582 "@defvarx SO_BROADCAST\n"
583 "@defvarx SO_SNDBUF\n"
584 "@defvarx SO_RCVBUF\n"
585 "@defvarx SO_KEEPALIVE\n"
586 "@defvarx SO_OOBINLINE\n"
587 "@defvarx SO_NO_CHECK\n"
588 "@defvarx SO_PRIORITY\n"
589 "@var{value} is an integer.\n"
592 "@defvar SO_LINGER\n"
593 "@var{value} is a pair of integers @code{(@var{ENABLE}\n"
594 ". @var{TIMEOUT})}. On old systems without timeout support\n"
595 "(ie.@: without @code{struct linger}), only @var{ENABLE} has an\n"
596 "effect but the value in Guile is always a pair.\n"
599 "@c Note that we refer only to ``man ip'' here. On GNU/Linux it's\n"
600 "@c ``man 7 ip'' but on NetBSD it's ``man 4 ip''.\n"
602 "For IP level (@code{IPPROTO_IP}) the following @var{optname}s\n"
603 "are defined (when provided by the system). See @command{man\n"
604 "ip} for what they mean.\n"
606 "@defvar IP_ADD_MEMBERSHIP\n"
607 "@defvarx IP_DROP_MEMBERSHIP\n"
608 "These can be used only with @code{setsockopt}, not\n"
609 "@code{getsockopt}. @var{value} is a pair\n"
610 "@code{(@var{MULTIADDR} . @var{INTERFACEADDR})} of IPv4\n"
611 "addresses (@pxref{Network Address Conversion}).\n"
612 "@var{MULTIADDR} is a multicast address to be added to or\n"
613 "dropped from the interface @var{INTERFACEADDR}.\n"
614 "@var{INTERFACEADDR} can be @code{INADDR_ANY} to have the system\n"
615 "select the interface. @var{INTERFACEADDR} can also be an\n"
616 "interface index number, on systems supporting that.\n"
618 #define FUNC_NAME s_scm_setsockopt
623 #ifdef HAVE_STRUCT_LINGER
624 struct linger opt_linger
;
627 #if HAVE_STRUCT_IP_MREQ
628 struct ip_mreq opt_mreq
;
631 const void *optval
= NULL
;
632 socklen_t optlen
= 0;
634 int ilevel
, ioptname
;
636 sock
= SCM_COERCE_OUTPORT (sock
);
638 SCM_VALIDATE_OPFPORT (1, sock
);
639 ilevel
= scm_to_int (level
);
640 ioptname
= scm_to_int (optname
);
642 fd
= SCM_FPORT_FDES (sock
);
644 if (ilevel
== SOL_SOCKET
)
647 if (ioptname
== SO_LINGER
)
649 #ifdef HAVE_STRUCT_LINGER
650 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
651 opt_linger
.l_onoff
= scm_to_int (SCM_CAR (value
));
652 opt_linger
.l_linger
= scm_to_int (SCM_CDR (value
));
653 optlen
= sizeof (struct linger
);
654 optval
= &opt_linger
;
656 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
657 opt_int
= scm_to_int (SCM_CAR (value
));
658 /* timeout is ignored, but may as well validate it. */
659 scm_to_int (SCM_CDR (value
));
660 optlen
= sizeof (int);
668 || ioptname
== SO_SNDBUF
671 || ioptname
== SO_RCVBUF
675 opt_int
= scm_to_int (value
);
676 optlen
= sizeof (size_t);
681 #if HAVE_STRUCT_IP_MREQ
682 if (ilevel
== IPPROTO_IP
&&
683 (ioptname
== IP_ADD_MEMBERSHIP
|| ioptname
== IP_DROP_MEMBERSHIP
))
685 /* Fourth argument must be a pair of addresses. */
686 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
687 opt_mreq
.imr_multiaddr
.s_addr
= htonl (scm_to_ulong (SCM_CAR (value
)));
688 opt_mreq
.imr_interface
.s_addr
= htonl (scm_to_ulong (SCM_CDR (value
)));
689 optlen
= sizeof (opt_mreq
);
696 /* Most options take an int. */
697 opt_int
= scm_to_int (value
);
698 optlen
= sizeof (int);
702 if (setsockopt (fd
, ilevel
, ioptname
, optval
, optlen
) == -1)
704 return SCM_UNSPECIFIED
;
708 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
710 "Sockets can be closed simply by using @code{close-port}. The\n"
711 "@code{shutdown} procedure allows reception or transmission on a\n"
712 "connection to be shut down individually, according to the parameter\n"
716 "Stop receiving data for this socket. If further data arrives, reject it.\n"
718 "Stop trying to transmit data from this socket. Discard any\n"
719 "data waiting to be sent. Stop looking for acknowledgement of\n"
720 "data already sent; don't retransmit it if it is lost.\n"
722 "Stop both reception and transmission.\n"
724 "The return value is unspecified.")
725 #define FUNC_NAME s_scm_shutdown
728 sock
= SCM_COERCE_OUTPORT (sock
);
729 SCM_VALIDATE_OPFPORT (1, sock
);
730 fd
= SCM_FPORT_FDES (sock
);
731 if (shutdown (fd
, scm_to_signed_integer (how
, 0, 2)) == -1)
733 return SCM_UNSPECIFIED
;
737 /* convert fam/address/args into a sockaddr of the appropriate type.
738 args is modified by removing the arguments actually used.
739 which_arg and proc are used when reporting errors:
740 which_arg is the position of address in the original argument list.
741 proc is the name of the original procedure.
742 size returns the size of the structure allocated. */
744 static struct sockaddr
*
745 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
746 const char *proc
, size_t *size
)
747 #define FUNC_NAME proc
753 struct sockaddr_in
*soka
;
757 SCM_VALIDATE_ULONG_COPY (which_arg
, address
, addr
);
758 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
759 port
= scm_to_int (SCM_CAR (*args
));
760 *args
= SCM_CDR (*args
);
761 soka
= (struct sockaddr_in
*) scm_malloc (sizeof (struct sockaddr_in
));
763 #if HAVE_STRUCT_SOCKADDR_SIN_LEN
764 soka
->sin_len
= sizeof (struct sockaddr_in
);
766 soka
->sin_family
= AF_INET
;
767 soka
->sin_addr
.s_addr
= htonl (addr
);
768 soka
->sin_port
= htons (port
);
769 *size
= sizeof (struct sockaddr_in
);
770 return (struct sockaddr
*) soka
;
777 struct sockaddr_in6
*soka
;
778 unsigned long flowinfo
= 0;
779 unsigned long scope_id
= 0;
781 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
782 port
= scm_to_int (SCM_CAR (*args
));
783 *args
= SCM_CDR (*args
);
784 if (scm_is_pair (*args
))
786 SCM_VALIDATE_ULONG_COPY (which_arg
+ 2, SCM_CAR (*args
), flowinfo
);
787 *args
= SCM_CDR (*args
);
788 if (scm_is_pair (*args
))
790 SCM_VALIDATE_ULONG_COPY (which_arg
+ 3, SCM_CAR (*args
),
792 *args
= SCM_CDR (*args
);
795 soka
= (struct sockaddr_in6
*) scm_malloc (sizeof (struct sockaddr_in6
));
797 #if HAVE_STRUCT_SOCKADDR_IN6_SIN6_LEN
798 soka
->sin6_len
= sizeof (struct sockaddr_in6
);
800 soka
->sin6_family
= AF_INET6
;
801 scm_to_ipv6 (soka
->sin6_addr
.s6_addr
, address
);
802 soka
->sin6_port
= htons (port
);
803 soka
->sin6_flowinfo
= flowinfo
;
804 #ifdef HAVE_SIN6_SCOPE_ID
805 soka
->sin6_scope_id
= scope_id
;
807 *size
= sizeof (struct sockaddr_in6
);
808 return (struct sockaddr
*) soka
;
811 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
814 struct sockaddr_un
*soka
;
818 scm_dynwind_begin (0);
820 c_address
= scm_to_locale_string (address
);
821 scm_dynwind_free (c_address
);
823 /* the static buffer size in sockaddr_un seems to be arbitrary
824 and not necessarily a hard limit. e.g., the glibc manual
825 suggests it may be possible to declare it size 0. let's
826 ignore it. if the O/S doesn't like the size it will cause
827 connect/bind etc., to fail. sun_path is always the last
828 member of the structure. */
829 addr_size
= sizeof (struct sockaddr_un
)
830 + max (0, strlen (c_address
) + 1 - (sizeof soka
->sun_path
));
831 soka
= (struct sockaddr_un
*) scm_malloc (addr_size
);
832 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
833 soka
->sun_family
= AF_UNIX
;
834 strcpy (soka
->sun_path
, c_address
);
835 *size
= SUN_LEN (soka
);
838 return (struct sockaddr
*) soka
;
842 scm_out_of_range (proc
, scm_from_int (fam
));
847 SCM_DEFINE (scm_connect
, "connect", 2, 1, 1,
848 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
849 "Initiate a connection from a socket using a specified address\n"
850 "family to the address\n"
851 "specified by @var{address} and possibly @var{args}.\n"
852 "The format required for @var{address}\n"
853 "and @var{args} depends on the family of the socket.\n\n"
854 "For a socket of family @code{AF_UNIX},\n"
855 "only @var{address} is specified and must be a string with the\n"
856 "filename where the socket is to be created.\n\n"
857 "For a socket of family @code{AF_INET},\n"
858 "@var{address} must be an integer IPv4 host address and\n"
859 "@var{args} must be a single integer port number.\n\n"
860 "For a socket of family @code{AF_INET6},\n"
861 "@var{address} must be an integer IPv6 host address and\n"
862 "@var{args} may be up to three integers:\n"
863 "port [flowinfo] [scope_id],\n"
864 "where flowinfo and scope_id default to zero.\n\n"
865 "Alternatively, the second argument can be a socket address object "
866 "as returned by @code{make-socket-address}, in which case the "
867 "no additional arguments should be passed.\n\n"
868 "The return value is unspecified.")
869 #define FUNC_NAME s_scm_connect
872 struct sockaddr
*soka
;
875 sock
= SCM_COERCE_OUTPORT (sock
);
876 SCM_VALIDATE_OPFPORT (1, sock
);
877 fd
= SCM_FPORT_FDES (sock
);
879 if (address
== SCM_UNDEFINED
)
880 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
881 `socket address' object. */
882 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
884 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
885 &args
, 3, FUNC_NAME
, &size
);
887 if (connect (fd
, soka
, size
) == -1)
889 int save_errno
= errno
;
896 return SCM_UNSPECIFIED
;
900 SCM_DEFINE (scm_bind
, "bind", 2, 1, 1,
901 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
902 "Assign an address to the socket port @var{sock}.\n"
903 "Generally this only needs to be done for server sockets,\n"
904 "so they know where to look for incoming connections. A socket\n"
905 "without an address will be assigned one automatically when it\n"
906 "starts communicating.\n\n"
907 "The format of @var{address} and @var{args} depends\n"
908 "on the family of the socket.\n\n"
909 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
910 "is specified and must be a string with the filename where\n"
911 "the socket is to be created.\n\n"
912 "For a socket of family @code{AF_INET}, @var{address}\n"
913 "must be an integer IPv4 address and @var{args}\n"
914 "must be a single integer port number.\n\n"
915 "The values of the following variables can also be used for\n"
917 "@defvar INADDR_ANY\n"
918 "Allow connections from any address.\n"
920 "@defvar INADDR_LOOPBACK\n"
921 "The address of the local host using the loopback device.\n"
923 "@defvar INADDR_BROADCAST\n"
924 "The broadcast address on the local network.\n"
926 "@defvar INADDR_NONE\n"
929 "For a socket of family @code{AF_INET6}, @var{address}\n"
930 "must be an integer IPv6 address and @var{args}\n"
931 "may be up to three integers:\n"
932 "port [flowinfo] [scope_id],\n"
933 "where flowinfo and scope_id default to zero.\n\n"
934 "Alternatively, the second argument can be a socket address object "
935 "as returned by @code{make-socket-address}, in which case the "
936 "no additional arguments should be passed.\n\n"
937 "The return value is unspecified.")
938 #define FUNC_NAME s_scm_bind
940 struct sockaddr
*soka
;
944 sock
= SCM_COERCE_OUTPORT (sock
);
945 SCM_VALIDATE_OPFPORT (1, sock
);
946 fd
= SCM_FPORT_FDES (sock
);
948 if (address
== SCM_UNDEFINED
)
949 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
950 `socket address' object. */
951 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
953 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
954 &args
, 3, FUNC_NAME
, &size
);
957 if (bind (fd
, soka
, size
) == -1)
959 int save_errno
= errno
;
966 return SCM_UNSPECIFIED
;
970 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
971 (SCM sock
, SCM backlog
),
972 "Enable @var{sock} to accept connection\n"
973 "requests. @var{backlog} is an integer specifying\n"
974 "the maximum length of the queue for pending connections.\n"
975 "If the queue fills, new clients will fail to connect until\n"
976 "the server calls @code{accept} to accept a connection from\n"
978 "The return value is unspecified.")
979 #define FUNC_NAME s_scm_listen
982 sock
= SCM_COERCE_OUTPORT (sock
);
983 SCM_VALIDATE_OPFPORT (1, sock
);
984 fd
= SCM_FPORT_FDES (sock
);
985 if (listen (fd
, scm_to_int (backlog
)) == -1)
987 return SCM_UNSPECIFIED
;
991 /* Put the components of a sockaddr into a new SCM vector. */
992 static SCM_C_INLINE_KEYWORD SCM
993 _scm_from_sockaddr (const scm_t_max_sockaddr
*address
, unsigned addr_size
,
996 SCM result
= SCM_EOL
;
997 short int fam
= ((struct sockaddr
*) address
)->sa_family
;
1003 const struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
1005 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
1007 SCM_SIMPLE_VECTOR_SET(result
, 0,
1008 scm_from_short (fam
));
1009 SCM_SIMPLE_VECTOR_SET(result
, 1,
1010 scm_from_ulong (ntohl (nad
->sin_addr
.s_addr
)));
1011 SCM_SIMPLE_VECTOR_SET(result
, 2,
1012 scm_from_ushort (ntohs (nad
->sin_port
)));
1018 const struct sockaddr_in6
*nad
= (struct sockaddr_in6
*) address
;
1020 result
= scm_c_make_vector (5, SCM_UNSPECIFIED
);
1021 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1022 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_ipv6 (nad
->sin6_addr
.s6_addr
));
1023 SCM_SIMPLE_VECTOR_SET(result
, 2, scm_from_ushort (ntohs (nad
->sin6_port
)));
1024 SCM_SIMPLE_VECTOR_SET(result
, 3, scm_from_uint32 (nad
->sin6_flowinfo
));
1025 #ifdef HAVE_SIN6_SCOPE_ID
1026 SCM_SIMPLE_VECTOR_SET(result
, 4, scm_from_ulong (nad
->sin6_scope_id
));
1028 SCM_SIMPLE_VECTOR_SET(result
, 4, SCM_INUM0
);
1033 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1036 const struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
1038 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
1040 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1041 /* When addr_size is not enough to cover sun_path, do not try
1043 if (addr_size
<= offsetof (struct sockaddr_un
, sun_path
))
1044 SCM_SIMPLE_VECTOR_SET(result
, 1, SCM_BOOL_F
);
1046 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_locale_string (nad
->sun_path
));
1051 result
= SCM_UNSPECIFIED
;
1052 scm_misc_error (proc
, "unrecognised address family: ~A",
1053 scm_list_1 (scm_from_int (fam
)));
1059 /* The publicly-visible function. Return a Scheme object representing
1060 ADDRESS, an address of ADDR_SIZE bytes. */
1062 scm_from_sockaddr (const struct sockaddr
*address
, unsigned addr_size
)
1064 return (_scm_from_sockaddr ((scm_t_max_sockaddr
*) address
,
1065 addr_size
, "scm_from_sockaddr"));
1068 /* Convert ADDRESS, an address object returned by either
1069 `scm_from_sockaddr ()' or `scm_make_socket_address ()', into its C
1070 representation. On success, a non-NULL pointer is returned and
1071 ADDRESS_SIZE is updated to the actual size (in bytes) of the returned
1072 address. The result must eventually be freed using `free ()'. */
1074 scm_to_sockaddr (SCM address
, size_t *address_size
)
1075 #define FUNC_NAME "scm_to_sockaddr"
1078 struct sockaddr
*c_address
= NULL
;
1080 SCM_VALIDATE_VECTOR (1, address
);
1083 family
= scm_to_short (SCM_SIMPLE_VECTOR_REF (address
, 0));
1089 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 3)
1090 scm_misc_error (FUNC_NAME
,
1091 "invalid inet address representation: ~A",
1092 scm_list_1 (address
));
1095 struct sockaddr_in c_inet
;
1097 c_inet
.sin_addr
.s_addr
=
1098 htonl (scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 1)));
1100 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1101 c_inet
.sin_family
= AF_INET
;
1103 *address_size
= sizeof (c_inet
);
1104 c_address
= scm_malloc (sizeof (c_inet
));
1105 memcpy (c_address
, &c_inet
, sizeof (c_inet
));
1114 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 5)
1115 scm_misc_error (FUNC_NAME
, "invalid inet6 address representation: ~A",
1116 scm_list_1 (address
));
1119 struct sockaddr_in6 c_inet6
;
1121 scm_to_ipv6 (c_inet6
.sin6_addr
.s6_addr
,
1122 SCM_SIMPLE_VECTOR_REF (address
, 1));
1124 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1125 c_inet6
.sin6_flowinfo
=
1126 scm_to_uint32 (SCM_SIMPLE_VECTOR_REF (address
, 3));
1127 #ifdef HAVE_SIN6_SCOPE_ID
1128 c_inet6
.sin6_scope_id
=
1129 scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 4));
1132 c_inet6
.sin6_family
= AF_INET6
;
1134 *address_size
= sizeof (c_inet6
);
1135 c_address
= scm_malloc (sizeof (c_inet6
));
1136 memcpy (c_address
, &c_inet6
, sizeof (c_inet6
));
1143 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1146 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 2)
1147 scm_misc_error (FUNC_NAME
, "invalid unix address representation: ~A",
1148 scm_list_1 (address
));
1152 size_t path_len
= 0;
1154 path
= SCM_SIMPLE_VECTOR_REF (address
, 1);
1155 if ((!scm_is_string (path
)) && (path
!= SCM_BOOL_F
))
1156 scm_misc_error (FUNC_NAME
, "invalid unix address "
1157 "path: ~A", scm_list_1 (path
));
1160 struct sockaddr_un c_unix
;
1162 if (path
== SCM_BOOL_F
)
1165 path_len
= scm_c_string_length (path
);
1167 #ifdef UNIX_PATH_MAX
1168 if (path_len
>= UNIX_PATH_MAX
)
1170 /* We can hope that this limit will eventually vanish, at least on GNU.
1171 However, currently, while glibc doesn't define `UNIX_PATH_MAX', it
1172 documents it has being limited to 108 bytes. */
1173 if (path_len
>= sizeof (c_unix
.sun_path
))
1175 scm_misc_error (FUNC_NAME
, "unix address path "
1176 "too long: ~A", scm_list_1 (path
));
1181 scm_to_locale_stringbuf (path
, c_unix
.sun_path
,
1182 #ifdef UNIX_PATH_MAX
1185 sizeof (c_unix
.sun_path
));
1187 c_unix
.sun_path
[path_len
] = '\0';
1190 if (strlen (c_unix
.sun_path
) != path_len
)
1191 scm_misc_error (FUNC_NAME
, "unix address path "
1192 "contains nul characters: ~A",
1196 c_unix
.sun_path
[0] = '\0';
1198 c_unix
.sun_family
= AF_UNIX
;
1200 *address_size
= SUN_LEN (&c_unix
);
1201 c_address
= scm_malloc (sizeof (c_unix
));
1202 memcpy (c_address
, &c_unix
, sizeof (c_unix
));
1212 scm_misc_error (FUNC_NAME
, "unrecognised address family: ~A",
1213 scm_list_1 (scm_from_ushort (family
)));
1221 /* Return a newly-allocated `sockaddr' structure that reflects ADDRESS, being
1222 an address of family FAMILY, with the family-specific parameters ARGS (see
1223 the description of `connect' for details). The returned structure may be
1224 freed using `free ()'. */
1226 scm_c_make_socket_address (SCM family
, SCM address
, SCM args
,
1227 size_t *address_size
)
1229 struct sockaddr
*soka
;
1231 soka
= scm_fill_sockaddr (scm_to_ushort (family
), address
, &args
, 1,
1232 "scm_c_make_socket_address", address_size
);
1237 SCM_DEFINE (scm_make_socket_address
, "make-socket-address", 2, 0, 1,
1238 (SCM family
, SCM address
, SCM args
),
1239 "Return a Scheme address object that reflects @var{address}, "
1240 "being an address of family @var{family}, with the "
1241 "family-specific parameters @var{args} (see the description of "
1242 "@code{connect} for details).")
1243 #define FUNC_NAME s_scm_make_socket_address
1245 SCM result
= SCM_BOOL_F
;
1246 struct sockaddr
*c_address
;
1247 size_t c_address_size
;
1249 c_address
= scm_c_make_socket_address (family
, address
, args
,
1251 if (c_address
!= NULL
)
1253 result
= scm_from_sockaddr (c_address
, c_address_size
);
1262 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
1264 "Accept a connection on a bound, listening socket.\n"
1266 "are no pending connections in the queue, wait until\n"
1267 "one is available unless the non-blocking option has been\n"
1268 "set on the socket.\n\n"
1269 "The return value is a\n"
1270 "pair in which the @emph{car} is a new socket port for the\n"
1272 "the @emph{cdr} is an object with address information about the\n"
1273 "client which initiated the connection.\n\n"
1274 "@var{sock} does not become part of the\n"
1275 "connection and will continue to accept new requests.")
1276 #define FUNC_NAME s_scm_accept
1282 SELECT_TYPE readfds
, exceptfds
;
1283 socklen_t addr_size
= MAX_ADDR_SIZE
;
1284 scm_t_max_sockaddr addr
;
1286 sock
= SCM_COERCE_OUTPORT (sock
);
1287 SCM_VALIDATE_OPFPORT (1, sock
);
1288 fd
= SCM_FPORT_FDES (sock
);
1291 FD_ZERO (&exceptfds
);
1292 FD_SET (fd
, &readfds
);
1293 FD_SET (fd
, &exceptfds
);
1295 /* Block until something happens on FD, leaving guile mode while
1297 selected
= scm_std_select (fd
+ 1, &readfds
, NULL
, &exceptfds
,
1302 newfd
= accept (fd
, (struct sockaddr
*) &addr
, &addr_size
);
1305 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
1306 address
= _scm_from_sockaddr (&addr
, addr_size
,
1309 return scm_cons (newsock
, address
);
1313 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
1315 "Return the address of @var{sock}, in the same form as the\n"
1316 "object returned by @code{accept}. On many systems the address\n"
1317 "of a socket in the @code{AF_FILE} namespace cannot be read.")
1318 #define FUNC_NAME s_scm_getsockname
1321 socklen_t addr_size
= MAX_ADDR_SIZE
;
1322 scm_t_max_sockaddr addr
;
1324 sock
= SCM_COERCE_OUTPORT (sock
);
1325 SCM_VALIDATE_OPFPORT (1, sock
);
1326 fd
= SCM_FPORT_FDES (sock
);
1327 if (getsockname (fd
, (struct sockaddr
*) &addr
, &addr_size
) == -1)
1330 return _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1334 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
1336 "Return the address that @var{sock}\n"
1337 "is connected to, in the same form as the object returned by\n"
1338 "@code{accept}. On many systems the address of a socket in the\n"
1339 "@code{AF_FILE} namespace cannot be read.")
1340 #define FUNC_NAME s_scm_getpeername
1343 socklen_t addr_size
= MAX_ADDR_SIZE
;
1344 scm_t_max_sockaddr addr
;
1346 sock
= SCM_COERCE_OUTPORT (sock
);
1347 SCM_VALIDATE_OPFPORT (1, sock
);
1348 fd
= SCM_FPORT_FDES (sock
);
1349 if (getpeername (fd
, (struct sockaddr
*) &addr
, &addr_size
) == -1)
1352 return _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1356 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
1357 (SCM sock
, SCM buf
, SCM flags
),
1358 "Receive data from a socket port.\n"
1359 "@var{sock} must already\n"
1360 "be bound to the address from which data is to be received.\n"
1361 "@var{buf} is a string into which\n"
1362 "the data will be written. The size of @var{buf} limits\n"
1364 "data which can be received: in the case of packet\n"
1365 "protocols, if a packet larger than this limit is encountered\n"
1367 "will be irrevocably lost.\n\n"
1368 "The data is assumed to be binary, and there is no decoding of\n"
1369 "of locale-encoded strings.\n\n"
1370 "The optional @var{flags} argument is a value or\n"
1371 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1372 "The value returned is the number of bytes read from the\n"
1374 "Note that the data is read directly from the socket file\n"
1376 "any unread buffered port data is ignored.")
1377 #define FUNC_NAME s_scm_recv
1386 SCM_VALIDATE_OPFPORT (1, sock
);
1387 SCM_VALIDATE_STRING (2, buf
);
1388 if (SCM_UNBNDP (flags
))
1391 flg
= scm_to_int (flags
);
1392 fd
= SCM_FPORT_FDES (sock
);
1394 len
= scm_i_string_length (buf
);
1395 msg
= scm_i_make_string (len
, &dest
);
1396 SCM_SYSCALL (rv
= recv (fd
, dest
, len
, flg
));
1397 scm_string_copy_x (buf
, scm_from_int (0),
1398 msg
, scm_from_int (0), scm_from_size_t (len
));
1403 scm_remember_upto_here_2 (buf
, msg
);
1404 return scm_from_int (rv
);
1408 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
1409 (SCM sock
, SCM message
, SCM flags
),
1410 "Transmit the string @var{message} on a socket port @var{sock}.\n"
1411 "@var{sock} must already be bound to a destination address. The\n"
1412 "value returned is the number of bytes transmitted --\n"
1413 "it's possible for\n"
1414 "this to be less than the length of @var{message}\n"
1415 "if the socket is\n"
1416 "set to be non-blocking. The optional @var{flags} argument\n"
1418 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1419 "Note that the data is written directly to the socket\n"
1420 "file descriptor:\n"
1421 "any unflushed buffered port data is ignored.\n\n"
1422 "This operation is defined only for strings containing codepoints\n"
1424 #define FUNC_NAME s_scm_send
1432 sock
= SCM_COERCE_OUTPORT (sock
);
1433 SCM_VALIDATE_OPFPORT (1, sock
);
1434 SCM_VALIDATE_STRING (2, message
);
1436 /* If the string is wide, see if it can be coerced into
1438 if (!scm_i_is_narrow_string (message
)
1439 || scm_i_try_narrow_string (message
))
1440 SCM_MISC_ERROR ("the message string is not 8-bit: ~s",
1441 scm_list_1 (message
));
1443 if (SCM_UNBNDP (flags
))
1446 flg
= scm_to_int (flags
);
1447 fd
= SCM_FPORT_FDES (sock
);
1449 len
= scm_i_string_length (message
);
1450 message
= scm_i_string_start_writing (message
);
1451 src
= scm_i_string_writable_chars (message
);
1452 SCM_SYSCALL (rv
= send (fd
, src
, len
, flg
));
1453 scm_i_string_stop_writing ();
1458 scm_remember_upto_here_1 (message
);
1459 return scm_from_int (rv
);
1463 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
1464 (SCM sock
, SCM str
, SCM flags
, SCM start
, SCM end
),
1465 "Receive data from socket port @var{sock} (which must be already\n"
1466 "bound), returning the originating address as well as the data.\n"
1467 "This is usually for use on datagram sockets, but can be used on\n"
1468 "stream-oriented sockets too.\n"
1470 "The data received is stored in the given @var{str}, using\n"
1471 "either the whole string or just the region between the optional\n"
1472 "@var{start} and @var{end} positions. The size of @var{str}\n"
1473 "limits the amount of data which can be received. For datagram\n"
1474 "protocols, if a packet larger than this is received then excess\n"
1475 "bytes are irrevocably lost.\n"
1477 "The return value is a pair. The @code{car} is the number of\n"
1478 "bytes read. The @code{cdr} is a socket address object which is\n"
1479 "where the data come from, or @code{#f} if the origin is\n"
1482 "The optional @var{flags} argument is a or bitwise OR\n"
1483 "(@code{logior}) of @code{MSG_OOB}, @code{MSG_PEEK},\n"
1484 "@code{MSG_DONTROUTE} etc.\n"
1486 "Data is read directly from the socket file descriptor, any\n"
1487 "buffered port data is ignored.\n"
1489 "On a GNU/Linux system @code{recvfrom!} is not multi-threading,\n"
1490 "all threads stop while a @code{recvfrom!} call is in progress.\n"
1491 "An application may need to use @code{select}, @code{O_NONBLOCK}\n"
1492 "or @code{MSG_DONTWAIT} to avoid this.")
1493 #define FUNC_NAME s_scm_recvfrom
1502 socklen_t addr_size
= MAX_ADDR_SIZE
;
1503 scm_t_max_sockaddr addr
;
1505 SCM_VALIDATE_OPFPORT (1, sock
);
1506 fd
= SCM_FPORT_FDES (sock
);
1508 SCM_VALIDATE_STRING (2, str
);
1509 scm_i_get_substring_spec (scm_i_string_length (str
),
1510 start
, &offset
, end
, &cend
);
1512 if (SCM_UNBNDP (flags
))
1515 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
1517 /* recvfrom will not necessarily return an address. usually nothing
1518 is returned for stream sockets. */
1519 str
= scm_i_string_start_writing (str
);
1520 buf
= scm_i_string_writable_chars (str
);
1521 ((struct sockaddr
*) &addr
)->sa_family
= AF_UNSPEC
;
1522 SCM_SYSCALL (rv
= recvfrom (fd
, buf
+ offset
,
1524 (struct sockaddr
*) &addr
, &addr_size
));
1525 scm_i_string_stop_writing ();
1529 if (((struct sockaddr
*) &addr
)->sa_family
!= AF_UNSPEC
)
1530 address
= _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1532 address
= SCM_BOOL_F
;
1534 scm_remember_upto_here_1 (str
);
1536 return scm_cons (scm_from_int (rv
), address
);
1540 SCM_DEFINE (scm_sendto
, "sendto", 3, 1, 1,
1541 (SCM sock
, SCM message
, SCM fam_or_sockaddr
, SCM address
, SCM args_and_flags
),
1542 "Transmit the string @var{message} on the socket port\n"
1544 "destination address is specified using the @var{fam},\n"
1545 "@var{address} and\n"
1546 "@var{args_and_flags} arguments, or just a socket address object "
1547 "returned by @code{make-socket-address}, in a similar way to the\n"
1548 "@code{connect} procedure. @var{args_and_flags} contains\n"
1549 "the usual connection arguments optionally followed by\n"
1550 "a flags argument, which is a value or\n"
1551 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1552 "The value returned is the number of bytes transmitted --\n"
1553 "it's possible for\n"
1554 "this to be less than the length of @var{message} if the\n"
1556 "set to be non-blocking.\n"
1557 "Note that the data is written directly to the socket\n"
1558 "file descriptor:\n"
1559 "any unflushed buffered port data is ignored.\n"
1560 "This operation is defined only for strings containing codepoints\n"
1562 #define FUNC_NAME s_scm_sendto
1567 struct sockaddr
*soka
;
1570 sock
= SCM_COERCE_OUTPORT (sock
);
1571 SCM_VALIDATE_FPORT (1, sock
);
1572 SCM_VALIDATE_STRING (2, message
);
1573 fd
= SCM_FPORT_FDES (sock
);
1575 if (!scm_is_number (fam_or_sockaddr
))
1577 /* FAM_OR_SOCKADDR must actually be a `socket address' object. This
1578 means that the following arguments, i.e. ADDRESS and those listed in
1579 ARGS_AND_FLAGS, are the `MSG_' flags. */
1580 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
1581 if (address
!= SCM_UNDEFINED
)
1582 args_and_flags
= scm_cons (address
, args_and_flags
);
1585 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
1586 &args_and_flags
, 3, FUNC_NAME
, &size
);
1588 if (scm_is_null (args_and_flags
))
1592 SCM_VALIDATE_CONS (5, args_and_flags
);
1593 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
1595 SCM_SYSCALL (rv
= sendto (fd
,
1596 scm_i_string_chars (message
),
1597 scm_i_string_length (message
),
1601 int save_errno
= errno
;
1608 scm_remember_upto_here_1 (message
);
1609 return scm_from_int (rv
);
1618 /* protocol families. */
1620 scm_c_define ("AF_UNSPEC", scm_from_int (AF_UNSPEC
));
1623 scm_c_define ("AF_UNIX", scm_from_int (AF_UNIX
));
1626 scm_c_define ("AF_INET", scm_from_int (AF_INET
));
1629 scm_c_define ("AF_INET6", scm_from_int (AF_INET6
));
1633 scm_c_define ("PF_UNSPEC", scm_from_int (PF_UNSPEC
));
1636 scm_c_define ("PF_UNIX", scm_from_int (PF_UNIX
));
1639 scm_c_define ("PF_INET", scm_from_int (PF_INET
));
1642 scm_c_define ("PF_INET6", scm_from_int (PF_INET6
));
1645 /* standard addresses. */
1647 scm_c_define ("INADDR_ANY", scm_from_ulong (INADDR_ANY
));
1649 #ifdef INADDR_BROADCAST
1650 scm_c_define ("INADDR_BROADCAST", scm_from_ulong (INADDR_BROADCAST
));
1653 scm_c_define ("INADDR_NONE", scm_from_ulong (INADDR_NONE
));
1655 #ifdef INADDR_LOOPBACK
1656 scm_c_define ("INADDR_LOOPBACK", scm_from_ulong (INADDR_LOOPBACK
));
1661 SOCK_PACKET is deliberately omitted, the GNU/Linux socket(2) and
1662 packet(7) advise that it's obsolete and strongly deprecated. */
1665 scm_c_define ("SOCK_STREAM", scm_from_int (SOCK_STREAM
));
1668 scm_c_define ("SOCK_DGRAM", scm_from_int (SOCK_DGRAM
));
1670 #ifdef SOCK_SEQPACKET
1671 scm_c_define ("SOCK_SEQPACKET", scm_from_int (SOCK_SEQPACKET
));
1674 scm_c_define ("SOCK_RAW", scm_from_int (SOCK_RAW
));
1677 scm_c_define ("SOCK_RDM", scm_from_int (SOCK_RDM
));
1680 /* setsockopt level.
1682 SOL_IP, SOL_TCP and SOL_UDP are defined on gnu/linux, but not on for
1683 instance NetBSD. We define IPPROTOs because that's what the posix spec
1684 shows in its example at
1686 http://www.opengroup.org/onlinepubs/007904975/functions/getsockopt.html
1689 scm_c_define ("SOL_SOCKET", scm_from_int (SOL_SOCKET
));
1692 scm_c_define ("IPPROTO_IP", scm_from_int (IPPROTO_IP
));
1695 scm_c_define ("IPPROTO_TCP", scm_from_int (IPPROTO_TCP
));
1698 scm_c_define ("IPPROTO_UDP", scm_from_int (IPPROTO_UDP
));
1701 /* setsockopt names. */
1703 scm_c_define ("SO_DEBUG", scm_from_int (SO_DEBUG
));
1706 scm_c_define ("SO_REUSEADDR", scm_from_int (SO_REUSEADDR
));
1709 scm_c_define ("SO_STYLE", scm_from_int (SO_STYLE
));
1712 scm_c_define ("SO_TYPE", scm_from_int (SO_TYPE
));
1715 scm_c_define ("SO_ERROR", scm_from_int (SO_ERROR
));
1718 scm_c_define ("SO_DONTROUTE", scm_from_int (SO_DONTROUTE
));
1721 scm_c_define ("SO_BROADCAST", scm_from_int (SO_BROADCAST
));
1724 scm_c_define ("SO_SNDBUF", scm_from_int (SO_SNDBUF
));
1727 scm_c_define ("SO_RCVBUF", scm_from_int (SO_RCVBUF
));
1730 scm_c_define ("SO_KEEPALIVE", scm_from_int (SO_KEEPALIVE
));
1733 scm_c_define ("SO_OOBINLINE", scm_from_int (SO_OOBINLINE
));
1736 scm_c_define ("SO_NO_CHECK", scm_from_int (SO_NO_CHECK
));
1739 scm_c_define ("SO_PRIORITY", scm_from_int (SO_PRIORITY
));
1742 scm_c_define ("SO_LINGER", scm_from_int (SO_LINGER
));
1745 /* recv/send options. */
1747 scm_c_define ("MSG_DONTWAIT", scm_from_int (MSG_DONTWAIT
));
1750 scm_c_define ("MSG_OOB", scm_from_int (MSG_OOB
));
1753 scm_c_define ("MSG_PEEK", scm_from_int (MSG_PEEK
));
1755 #ifdef MSG_DONTROUTE
1756 scm_c_define ("MSG_DONTROUTE", scm_from_int (MSG_DONTROUTE
));
1760 scm_i_init_socket_Win32 ();
1763 #ifdef IP_ADD_MEMBERSHIP
1764 scm_c_define ("IP_ADD_MEMBERSHIP", scm_from_int (IP_ADD_MEMBERSHIP
));
1765 scm_c_define ("IP_DROP_MEMBERSHIP", scm_from_int (IP_DROP_MEMBERSHIP
));
1768 scm_add_feature ("socket");
1770 #include "libguile/socket.x"