1 /* Copyright (C) 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005,
2 * 2006, 2007, 2009, 2011, 2012 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
31 #include "libguile/_scm.h"
32 #include "libguile/arrays.h"
33 #include "libguile/feature.h"
34 #include "libguile/fports.h"
35 #include "libguile/strings.h"
36 #include "libguile/vectors.h"
37 #include "libguile/dynwind.h"
38 #include "libguile/srfi-13.h"
40 #include "libguile/validate.h"
41 #include "libguile/socket.h"
43 #if SCM_ENABLE_DEPRECATED == 1
44 # include "libguile/deprecation.h"
48 #include "win32-socket.h"
61 #include <sys/types.h>
62 #ifdef HAVE_WINSOCK2_H
65 #include <sys/socket.h>
66 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
69 #include <netinet/in.h>
71 #include <arpa/inet.h>
74 #if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
75 #define SUN_LEN(ptr) ((size_t) (((struct sockaddr_un *) 0)->sun_path) \
76 + strlen ((ptr)->sun_path))
79 /* The largest possible socket address. Wrapping it in a union guarantees
80 that the compiler will make it suitably aligned. */
83 struct sockaddr sockaddr
;
84 struct sockaddr_in sockaddr_in
;
86 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
87 struct sockaddr_un sockaddr_un
;
90 struct sockaddr_in6 sockaddr_in6
;
95 /* Maximum size of a socket address. */
96 #define MAX_ADDR_SIZE (sizeof (scm_t_max_sockaddr))
101 SCM_DEFINE (scm_htons
, "htons", 1, 0, 0,
103 "Convert a 16 bit quantity from host to network byte ordering.\n"
104 "@var{value} is packed into 2 bytes, which are then converted\n"
105 "and returned as a new integer.")
106 #define FUNC_NAME s_scm_htons
108 return scm_from_ushort (htons (scm_to_ushort (value
)));
112 SCM_DEFINE (scm_ntohs
, "ntohs", 1, 0, 0,
114 "Convert a 16 bit quantity from network to host byte ordering.\n"
115 "@var{value} is packed into 2 bytes, which are then converted\n"
116 "and returned as a new integer.")
117 #define FUNC_NAME s_scm_ntohs
119 return scm_from_ushort (ntohs (scm_to_ushort (value
)));
123 SCM_DEFINE (scm_htonl
, "htonl", 1, 0, 0,
125 "Convert a 32 bit quantity from host to network byte ordering.\n"
126 "@var{value} is packed into 4 bytes, which are then converted\n"
127 "and returned as a new integer.")
128 #define FUNC_NAME s_scm_htonl
130 return scm_from_ulong (htonl (scm_to_uint32 (value
)));
134 SCM_DEFINE (scm_ntohl
, "ntohl", 1, 0, 0,
136 "Convert a 32 bit quantity from network to host byte ordering.\n"
137 "@var{value} is packed into 4 bytes, which are then converted\n"
138 "and returned as a new integer.")
139 #define FUNC_NAME s_scm_ntohl
141 return scm_from_ulong (ntohl (scm_to_uint32 (value
)));
145 #ifdef HAVE_INET_NETOF
146 SCM_DEFINE (scm_inet_netof
, "inet-netof", 1, 0, 0,
148 "Return the network number part of the given IPv4\n"
149 "Internet address. E.g.,\n\n"
151 "(inet-netof 2130706433) @result{} 127\n"
153 #define FUNC_NAME s_scm_inet_netof
156 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
157 return scm_from_ulong (inet_netof (addr
));
162 #ifdef HAVE_INET_LNAOF
163 SCM_DEFINE (scm_lnaof
, "inet-lnaof", 1, 0, 0,
165 "Return the local-address-with-network part of the given\n"
166 "IPv4 Internet address, using the obsolete class A/B/C system.\n"
169 "(inet-lnaof 2130706433) @result{} 1\n"
171 #define FUNC_NAME s_scm_lnaof
174 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
175 return scm_from_ulong (inet_lnaof (addr
));
180 #ifdef HAVE_INET_MAKEADDR
181 SCM_DEFINE (scm_inet_makeaddr
, "inet-makeaddr", 2, 0, 0,
183 "Make an IPv4 Internet address by combining the network number\n"
184 "@var{net} with the local-address-within-network number\n"
185 "@var{lna}. E.g.,\n\n"
187 "(inet-makeaddr 127 1) @result{} 2130706433\n"
189 #define FUNC_NAME s_scm_inet_makeaddr
192 unsigned long netnum
;
193 unsigned long lnanum
;
195 netnum
= SCM_NUM2ULONG (1, net
);
196 lnanum
= SCM_NUM2ULONG (2, lna
);
197 addr
= inet_makeaddr (netnum
, lnanum
);
198 return scm_from_ulong (ntohl (addr
.s_addr
));
205 /* flip a 128 bit IPv6 address between host and network order. */
206 #ifdef WORDS_BIGENDIAN
207 #define FLIP_NET_HOST_128(addr)
209 #define FLIP_NET_HOST_128(addr)\
213 for (i = 0; i < 8; i++)\
215 scm_t_uint8 c = (addr)[i];\
217 (addr)[i] = (addr)[15 - i];\
223 #ifdef WORDS_BIGENDIAN
224 #define FLIPCPY_NET_HOST_128(dest, src) memcpy (dest, src, 16)
226 #define FLIPCPY_NET_HOST_128(dest, src) \
228 const scm_t_uint8 *tmp_srcp = (src) + 15; \
229 scm_t_uint8 *tmp_destp = (dest); \
232 *tmp_destp++ = *tmp_srcp--; \
233 } while (tmp_srcp != (src)); \
238 #if (SIZEOF_SCM_T_BITS * SCM_CHAR_BIT) > 128
239 #error "Assumption that scm_t_bits <= 128 bits has been violated."
242 #if (SIZEOF_UNSIGNED_LONG * SCM_CHAR_BIT) > 128
243 #error "Assumption that unsigned long <= 128 bits has been violated."
246 #if (SIZEOF_UNSIGNED_LONG_LONG * SCM_CHAR_BIT) > 128
247 #error "Assumption that unsigned long long <= 128 bits has been violated."
250 /* convert a 128 bit IPv6 address in network order to a host ordered
253 scm_from_ipv6 (const scm_t_uint8
*src
)
255 SCM result
= scm_i_mkbig ();
256 mpz_import (SCM_I_BIG_MPZ (result
),
258 1, /* big-endian chunk ordering */
259 16, /* chunks are 16 bytes long */
260 1, /* big-endian byte ordering */
261 0, /* "nails" -- leading unused bits per chunk */
263 return scm_i_normbig (result
);
266 /* convert a host ordered SCM integer to a 128 bit IPv6 address in
269 scm_to_ipv6 (scm_t_uint8 dst
[16], SCM src
)
271 if (SCM_I_INUMP (src
))
273 scm_t_signed_bits n
= SCM_I_INUM (src
);
275 scm_out_of_range (NULL
, src
);
276 #ifdef WORDS_BIGENDIAN
277 memset (dst
, 0, 16 - sizeof (scm_t_signed_bits
));
278 memcpy (dst
+ (16 - sizeof (scm_t_signed_bits
)),
280 sizeof (scm_t_signed_bits
));
282 memset (dst
+ sizeof (scm_t_signed_bits
),
284 16 - sizeof (scm_t_signed_bits
));
285 /* FIXME: this pair of ops is kinda wasteful -- should rewrite as
286 a single loop perhaps, similar to the handling of bignums. */
287 memcpy (dst
, &n
, sizeof (scm_t_signed_bits
));
288 FLIP_NET_HOST_128 (dst
);
291 else if (SCM_BIGP (src
))
295 if ((mpz_sgn (SCM_I_BIG_MPZ (src
)) < 0)
296 || mpz_sizeinbase (SCM_I_BIG_MPZ (src
), 2) > 128)
297 scm_out_of_range (NULL
, src
);
302 1, /* big-endian chunk ordering */
303 16, /* chunks are 16 bytes long */
304 1, /* big-endian byte ordering */
305 0, /* "nails" -- leading unused bits per chunk */
306 SCM_I_BIG_MPZ (src
));
307 scm_remember_upto_here_1 (src
);
310 scm_wrong_type_arg_msg ("scm_to_ipv6", 0, src
, "integer");
313 #endif /* HAVE_IPV6 */
317 SCM_DEFINE (scm_inet_ntop
, "inet-ntop", 2, 0, 0,
318 (SCM family
, SCM address
),
319 "Convert a network address into a printable string.\n"
320 "Note that unlike the C version of this function,\n"
321 "the input is an integer with normal host byte ordering.\n"
322 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
324 "(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
325 "(inet-ntop AF_INET6 (- (expt 2 128) 1))\n"
326 " @result{} \"ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\"\n"
328 #define FUNC_NAME s_scm_inet_ntop
331 #ifdef INET6_ADDRSTRLEN
332 char dst
[INET6_ADDRSTRLEN
];
338 af
= scm_to_int (family
);
339 SCM_ASSERT_RANGE (1, family
,
349 addr4
= htonl (SCM_NUM2ULONG (2, address
));
350 result
= inet_ntop (af
, &addr4
, dst
, sizeof (dst
));
353 else if (af
== AF_INET6
)
357 scm_to_ipv6 ((scm_t_uint8
*) addr6
, address
);
358 result
= inet_ntop (af
, &addr6
, dst
, sizeof (dst
));
362 SCM_MISC_ERROR ("unsupported address family", family
);
367 return scm_from_locale_string (dst
);
371 SCM_DEFINE (scm_inet_pton
, "inet-pton", 2, 0, 0,
372 (SCM family
, SCM address
),
373 "Convert a string containing a printable network address to\n"
374 "an integer address. Note that unlike the C version of this\n"
376 "the result is an integer with normal host byte ordering.\n"
377 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
379 "(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
380 "(inet-pton AF_INET6 \"::1\") @result{} 1\n"
382 #define FUNC_NAME s_scm_inet_pton
389 af
= scm_to_int (family
);
390 SCM_ASSERT_RANGE (1, family
,
397 src
= scm_to_locale_string (address
);
398 rv
= inet_pton (af
, src
, dst
);
406 SCM_MISC_ERROR ("Bad address", SCM_EOL
);
408 return scm_from_ulong (ntohl (*dst
));
410 else if (af
== AF_INET6
)
411 return scm_from_ipv6 ((scm_t_uint8
*) dst
);
414 SCM_MISC_ERROR ("unsupported address family", family
);
419 SCM_SYMBOL (sym_socket
, "socket");
421 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
423 SCM_DEFINE (scm_socket
, "socket", 3, 0, 0,
424 (SCM family
, SCM style
, SCM proto
),
425 "Return a new socket port of the type specified by @var{family},\n"
426 "@var{style} and @var{proto}. All three parameters are\n"
427 "integers. Supported values for @var{family} are\n"
428 "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
429 "Typical values for @var{style} are @code{SOCK_STREAM},\n"
430 "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
431 "@var{proto} can be obtained from a protocol name using\n"
432 "@code{getprotobyname}. A value of zero specifies the default\n"
433 "protocol, which is usually right.\n\n"
434 "A single socket port cannot by used for communication until it\n"
435 "has been connected to another socket.")
436 #define FUNC_NAME s_scm_socket
440 fd
= socket (scm_to_int (family
),
445 return SCM_SOCK_FD_TO_PORT (fd
);
449 #ifdef HAVE_SOCKETPAIR
450 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
451 (SCM family
, SCM style
, SCM proto
),
452 "Return a pair of connected (but unnamed) socket ports of the\n"
453 "type specified by @var{family}, @var{style} and @var{proto}.\n"
454 "Many systems support only socket pairs of the @code{AF_UNIX}\n"
455 "family. Zero is likely to be the only meaningful value for\n"
457 #define FUNC_NAME s_scm_socketpair
462 fam
= scm_to_int (family
);
464 if (socketpair (fam
, scm_to_int (style
), scm_to_int (proto
), fd
) == -1)
467 return scm_cons (SCM_SOCK_FD_TO_PORT (fd
[0]), SCM_SOCK_FD_TO_PORT (fd
[1]));
472 /* Possible results for `getsockopt ()'. Wrapping it into a union guarantees
473 suitable alignment. */
476 #ifdef HAVE_STRUCT_LINGER
477 struct linger linger
;
481 } scm_t_getsockopt_result
;
483 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
484 (SCM sock
, SCM level
, SCM optname
),
485 "Return an option value from socket port @var{sock}.\n"
487 "@var{level} is an integer specifying a protocol layer, either\n"
488 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
489 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
490 "(@pxref{Network Databases}).\n"
492 "@defvar SOL_SOCKET\n"
493 "@defvarx IPPROTO_IP\n"
494 "@defvarx IPPROTO_TCP\n"
495 "@defvarx IPPROTO_UDP\n"
498 "@var{optname} is an integer specifying an option within the\n"
501 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
502 "defined (when provided by the system). For their meaning see\n"
503 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
504 "Manual}, or @command{man 7 socket}.\n"
507 "@defvarx SO_REUSEADDR\n"
508 "@defvarx SO_STYLE\n"
510 "@defvarx SO_ERROR\n"
511 "@defvarx SO_DONTROUTE\n"
512 "@defvarx SO_BROADCAST\n"
513 "@defvarx SO_SNDBUF\n"
514 "@defvarx SO_RCVBUF\n"
515 "@defvarx SO_KEEPALIVE\n"
516 "@defvarx SO_OOBINLINE\n"
517 "@defvarx SO_NO_CHECK\n"
518 "@defvarx SO_PRIORITY\n"
519 "The value returned is an integer.\n"
522 "@defvar SO_LINGER\n"
523 "The value returned is a pair of integers\n"
524 "@code{(@var{enable} . @var{timeout})}. On old systems without\n"
525 "timeout support (ie.@: without @code{struct linger}), only\n"
526 "@var{enable} has an effect but the value in Guile is always a\n"
529 #define FUNC_NAME s_scm_getsockopt
532 /* size of optval is the largest supported option. */
533 scm_t_getsockopt_result optval
;
534 socklen_t optlen
= sizeof (optval
);
538 sock
= SCM_COERCE_OUTPORT (sock
);
539 SCM_VALIDATE_OPFPORT (1, sock
);
540 ilevel
= scm_to_int (level
);
541 ioptname
= scm_to_int (optname
);
543 fd
= SCM_FPORT_FDES (sock
);
544 if (getsockopt (fd
, ilevel
, ioptname
, (void *) &optval
, &optlen
) == -1)
547 if (ilevel
== SOL_SOCKET
)
550 if (ioptname
== SO_LINGER
)
552 #ifdef HAVE_STRUCT_LINGER
553 struct linger
*ling
= (struct linger
*) &optval
;
555 return scm_cons (scm_from_long (ling
->l_onoff
),
556 scm_from_long (ling
->l_linger
));
558 return scm_cons (scm_from_long (*(int *) &optval
),
566 || ioptname
== SO_SNDBUF
569 || ioptname
== SO_RCVBUF
573 return scm_from_size_t (*(size_t *) &optval
);
576 return scm_from_int (*(int *) &optval
);
580 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
581 (SCM sock
, SCM level
, SCM optname
, SCM value
),
582 "Set an option on socket port @var{sock}. The return value is\n"
585 "@var{level} is an integer specifying a protocol layer, either\n"
586 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
587 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
588 "(@pxref{Network Databases}).\n"
590 "@defvar SOL_SOCKET\n"
591 "@defvarx IPPROTO_IP\n"
592 "@defvarx IPPROTO_TCP\n"
593 "@defvarx IPPROTO_UDP\n"
596 "@var{optname} is an integer specifying an option within the\n"
599 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
600 "defined (when provided by the system). For their meaning see\n"
601 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
602 "Manual}, or @command{man 7 socket}.\n"
605 "@defvarx SO_REUSEADDR\n"
606 "@defvarx SO_STYLE\n"
608 "@defvarx SO_ERROR\n"
609 "@defvarx SO_DONTROUTE\n"
610 "@defvarx SO_BROADCAST\n"
611 "@defvarx SO_SNDBUF\n"
612 "@defvarx SO_RCVBUF\n"
613 "@defvarx SO_KEEPALIVE\n"
614 "@defvarx SO_OOBINLINE\n"
615 "@defvarx SO_NO_CHECK\n"
616 "@defvarx SO_PRIORITY\n"
617 "@var{value} is an integer.\n"
620 "@defvar SO_LINGER\n"
621 "@var{value} is a pair of integers @code{(@var{ENABLE}\n"
622 ". @var{TIMEOUT})}. On old systems without timeout support\n"
623 "(ie.@: without @code{struct linger}), only @var{ENABLE} has an\n"
624 "effect but the value in Guile is always a pair.\n"
627 "@c Note that we refer only to ``man ip'' here. On GNU/Linux it's\n"
628 "@c ``man 7 ip'' but on NetBSD it's ``man 4 ip''.\n"
630 "For IP level (@code{IPPROTO_IP}) the following @var{optname}s\n"
631 "are defined (when provided by the system). See @command{man\n"
632 "ip} for what they mean.\n"
634 "@defvar IP_MULTICAST_IF\n"
635 "This sets the source interface used by multicast traffic.\n"
638 "@defvar IP_MULTICAST_TTL\n"
639 "This sets the default TTL for multicast traffic. This defaults \n"
640 "to 1 and should be increased to allow traffic to pass beyond the\n"
644 "@defvar IP_ADD_MEMBERSHIP\n"
645 "@defvarx IP_DROP_MEMBERSHIP\n"
646 "These can be used only with @code{setsockopt}, not\n"
647 "@code{getsockopt}. @var{value} is a pair\n"
648 "@code{(@var{MULTIADDR} . @var{INTERFACEADDR})} of IPv4\n"
649 "addresses (@pxref{Network Address Conversion}).\n"
650 "@var{MULTIADDR} is a multicast address to be added to or\n"
651 "dropped from the interface @var{INTERFACEADDR}.\n"
652 "@var{INTERFACEADDR} can be @code{INADDR_ANY} to have the system\n"
653 "select the interface. @var{INTERFACEADDR} can also be an\n"
654 "interface index number, on systems supporting that.\n"
656 #define FUNC_NAME s_scm_setsockopt
661 #ifdef HAVE_STRUCT_LINGER
662 struct linger opt_linger
;
665 #ifdef HAVE_STRUCT_IP_MREQ
666 struct ip_mreq opt_mreq
;
669 const void *optval
= NULL
;
670 socklen_t optlen
= 0;
672 int ilevel
, ioptname
;
674 sock
= SCM_COERCE_OUTPORT (sock
);
676 SCM_VALIDATE_OPFPORT (1, sock
);
677 ilevel
= scm_to_int (level
);
678 ioptname
= scm_to_int (optname
);
680 fd
= SCM_FPORT_FDES (sock
);
682 if (ilevel
== SOL_SOCKET
)
685 if (ioptname
== SO_LINGER
)
687 #ifdef HAVE_STRUCT_LINGER
688 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
689 opt_linger
.l_onoff
= scm_to_int (SCM_CAR (value
));
690 opt_linger
.l_linger
= scm_to_int (SCM_CDR (value
));
691 optlen
= sizeof (struct linger
);
692 optval
= &opt_linger
;
694 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
695 opt_int
= scm_to_int (SCM_CAR (value
));
696 /* timeout is ignored, but may as well validate it. */
697 scm_to_int (SCM_CDR (value
));
698 optlen
= sizeof (int);
706 || ioptname
== SO_SNDBUF
709 || ioptname
== SO_RCVBUF
713 opt_int
= scm_to_int (value
);
714 optlen
= sizeof (size_t);
719 #ifdef HAVE_STRUCT_IP_MREQ
720 if (ilevel
== IPPROTO_IP
&&
721 (ioptname
== IP_ADD_MEMBERSHIP
|| ioptname
== IP_DROP_MEMBERSHIP
))
723 /* Fourth argument must be a pair of addresses. */
724 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
725 opt_mreq
.imr_multiaddr
.s_addr
= htonl (scm_to_ulong (SCM_CAR (value
)));
726 opt_mreq
.imr_interface
.s_addr
= htonl (scm_to_ulong (SCM_CDR (value
)));
727 optlen
= sizeof (opt_mreq
);
734 /* Most options take an int. */
735 opt_int
= scm_to_int (value
);
736 optlen
= sizeof (int);
740 if (setsockopt (fd
, ilevel
, ioptname
, optval
, optlen
) == -1)
742 return SCM_UNSPECIFIED
;
746 /* Our documentation hard-codes this mapping, so make sure it holds. */
747 verify (SHUT_RD
== 0);
748 verify (SHUT_WR
== 1);
749 verify (SHUT_RDWR
== 2);
751 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
753 "Sockets can be closed simply by using @code{close-port}. The\n"
754 "@code{shutdown} procedure allows reception or transmission on a\n"
755 "connection to be shut down individually, according to the parameter\n"
759 "Stop receiving data for this socket. If further data arrives, reject it.\n"
761 "Stop trying to transmit data from this socket. Discard any\n"
762 "data waiting to be sent. Stop looking for acknowledgement of\n"
763 "data already sent; don't retransmit it if it is lost.\n"
765 "Stop both reception and transmission.\n"
767 "The return value is unspecified.")
768 #define FUNC_NAME s_scm_shutdown
771 sock
= SCM_COERCE_OUTPORT (sock
);
772 SCM_VALIDATE_OPFPORT (1, sock
);
773 fd
= SCM_FPORT_FDES (sock
);
774 if (shutdown (fd
, scm_to_signed_integer (how
, 0, 2)) == -1)
776 return SCM_UNSPECIFIED
;
780 /* convert fam/address/args into a sockaddr of the appropriate type.
781 args is modified by removing the arguments actually used.
782 which_arg and proc are used when reporting errors:
783 which_arg is the position of address in the original argument list.
784 proc is the name of the original procedure.
785 size returns the size of the structure allocated. */
787 static struct sockaddr
*
788 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
789 const char *proc
, size_t *size
)
790 #define FUNC_NAME proc
796 struct sockaddr_in
*soka
;
800 SCM_VALIDATE_ULONG_COPY (which_arg
, address
, addr
);
801 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
802 port
= scm_to_int (SCM_CAR (*args
));
803 *args
= SCM_CDR (*args
);
804 soka
= (struct sockaddr_in
*) scm_malloc (sizeof (struct sockaddr_in
));
805 memset (soka
, '\0', sizeof (struct sockaddr_in
));
807 #ifdef HAVE_STRUCT_SOCKADDR_IN_SIN_LEN
808 soka
->sin_len
= sizeof (struct sockaddr_in
);
810 soka
->sin_family
= AF_INET
;
811 soka
->sin_addr
.s_addr
= htonl (addr
);
812 soka
->sin_port
= htons (port
);
813 *size
= sizeof (struct sockaddr_in
);
814 return (struct sockaddr
*) soka
;
821 struct sockaddr_in6
*soka
;
822 unsigned long flowinfo
= 0;
823 unsigned long scope_id
= 0;
825 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
826 port
= scm_to_int (SCM_CAR (*args
));
827 *args
= SCM_CDR (*args
);
828 if (scm_is_pair (*args
))
830 SCM_VALIDATE_ULONG_COPY (which_arg
+ 2, SCM_CAR (*args
), flowinfo
);
831 *args
= SCM_CDR (*args
);
832 if (scm_is_pair (*args
))
834 SCM_VALIDATE_ULONG_COPY (which_arg
+ 3, SCM_CAR (*args
),
836 *args
= SCM_CDR (*args
);
839 soka
= (struct sockaddr_in6
*) scm_malloc (sizeof (struct sockaddr_in6
));
841 #ifdef HAVE_STRUCT_SOCKADDR_IN6_SIN6_LEN
842 soka
->sin6_len
= sizeof (struct sockaddr_in6
);
844 soka
->sin6_family
= AF_INET6
;
845 scm_to_ipv6 (soka
->sin6_addr
.s6_addr
, address
);
846 soka
->sin6_port
= htons (port
);
847 soka
->sin6_flowinfo
= flowinfo
;
848 #ifdef HAVE_SIN6_SCOPE_ID
849 soka
->sin6_scope_id
= scope_id
;
851 *size
= sizeof (struct sockaddr_in6
);
852 return (struct sockaddr
*) soka
;
855 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
858 struct sockaddr_un
*soka
;
862 scm_dynwind_begin (0);
864 c_address
= scm_to_locale_string (address
);
865 scm_dynwind_free (c_address
);
867 /* the static buffer size in sockaddr_un seems to be arbitrary
868 and not necessarily a hard limit. e.g., the glibc manual
869 suggests it may be possible to declare it size 0. let's
870 ignore it. if the O/S doesn't like the size it will cause
871 connect/bind etc., to fail. sun_path is always the last
872 member of the structure. */
873 addr_size
= sizeof (struct sockaddr_un
)
874 + max (0, strlen (c_address
) + 1 - (sizeof soka
->sun_path
));
875 soka
= (struct sockaddr_un
*) scm_malloc (addr_size
);
876 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
877 soka
->sun_family
= AF_UNIX
;
878 strcpy (soka
->sun_path
, c_address
);
879 *size
= SUN_LEN (soka
);
882 return (struct sockaddr
*) soka
;
886 scm_out_of_range (proc
, scm_from_int (fam
));
891 SCM_DEFINE (scm_connect
, "connect", 2, 1, 1,
892 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
893 "Initiate a connection from a socket using a specified address\n"
894 "family to the address\n"
895 "specified by @var{address} and possibly @var{args}.\n"
896 "The format required for @var{address}\n"
897 "and @var{args} depends on the family of the socket.\n\n"
898 "For a socket of family @code{AF_UNIX},\n"
899 "only @var{address} is specified and must be a string with the\n"
900 "filename where the socket is to be created.\n\n"
901 "For a socket of family @code{AF_INET},\n"
902 "@var{address} must be an integer IPv4 host address and\n"
903 "@var{args} must be a single integer port number.\n\n"
904 "For a socket of family @code{AF_INET6},\n"
905 "@var{address} must be an integer IPv6 host address and\n"
906 "@var{args} may be up to three integers:\n"
907 "port [flowinfo] [scope_id],\n"
908 "where flowinfo and scope_id default to zero.\n\n"
909 "Alternatively, the second argument can be a socket address object "
910 "as returned by @code{make-socket-address}, in which case the "
911 "no additional arguments should be passed.\n\n"
912 "The return value is unspecified.")
913 #define FUNC_NAME s_scm_connect
916 struct sockaddr
*soka
;
919 sock
= SCM_COERCE_OUTPORT (sock
);
920 SCM_VALIDATE_OPFPORT (1, sock
);
921 fd
= SCM_FPORT_FDES (sock
);
923 if (scm_is_eq (address
, SCM_UNDEFINED
))
924 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
925 `socket address' object. */
926 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
928 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
929 &args
, 3, FUNC_NAME
, &size
);
931 if (connect (fd
, soka
, size
) == -1)
933 int save_errno
= errno
;
940 return SCM_UNSPECIFIED
;
944 SCM_DEFINE (scm_bind
, "bind", 2, 1, 1,
945 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
946 "Assign an address to the socket port @var{sock}.\n"
947 "Generally this only needs to be done for server sockets,\n"
948 "so they know where to look for incoming connections. A socket\n"
949 "without an address will be assigned one automatically when it\n"
950 "starts communicating.\n\n"
951 "The format of @var{address} and @var{args} depends\n"
952 "on the family of the socket.\n\n"
953 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
954 "is specified and must be a string with the filename where\n"
955 "the socket is to be created.\n\n"
956 "For a socket of family @code{AF_INET}, @var{address}\n"
957 "must be an integer IPv4 address and @var{args}\n"
958 "must be a single integer port number.\n\n"
959 "The values of the following variables can also be used for\n"
961 "@defvar INADDR_ANY\n"
962 "Allow connections from any address.\n"
964 "@defvar INADDR_LOOPBACK\n"
965 "The address of the local host using the loopback device.\n"
967 "@defvar INADDR_BROADCAST\n"
968 "The broadcast address on the local network.\n"
970 "@defvar INADDR_NONE\n"
973 "For a socket of family @code{AF_INET6}, @var{address}\n"
974 "must be an integer IPv6 address and @var{args}\n"
975 "may be up to three integers:\n"
976 "port [flowinfo] [scope_id],\n"
977 "where flowinfo and scope_id default to zero.\n\n"
978 "Alternatively, the second argument can be a socket address object "
979 "as returned by @code{make-socket-address}, in which case the "
980 "no additional arguments should be passed.\n\n"
981 "The return value is unspecified.")
982 #define FUNC_NAME s_scm_bind
984 struct sockaddr
*soka
;
988 sock
= SCM_COERCE_OUTPORT (sock
);
989 SCM_VALIDATE_OPFPORT (1, sock
);
990 fd
= SCM_FPORT_FDES (sock
);
992 if (scm_is_eq (address
, SCM_UNDEFINED
))
993 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
994 `socket address' object. */
995 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
997 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
998 &args
, 3, FUNC_NAME
, &size
);
1001 if (bind (fd
, soka
, size
) == -1)
1003 int save_errno
= errno
;
1010 return SCM_UNSPECIFIED
;
1014 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
1015 (SCM sock
, SCM backlog
),
1016 "Enable @var{sock} to accept connection\n"
1017 "requests. @var{backlog} is an integer specifying\n"
1018 "the maximum length of the queue for pending connections.\n"
1019 "If the queue fills, new clients will fail to connect until\n"
1020 "the server calls @code{accept} to accept a connection from\n"
1022 "The return value is unspecified.")
1023 #define FUNC_NAME s_scm_listen
1026 sock
= SCM_COERCE_OUTPORT (sock
);
1027 SCM_VALIDATE_OPFPORT (1, sock
);
1028 fd
= SCM_FPORT_FDES (sock
);
1029 if (listen (fd
, scm_to_int (backlog
)) == -1)
1031 return SCM_UNSPECIFIED
;
1035 /* Put the components of a sockaddr into a new SCM vector. */
1036 static SCM_C_INLINE_KEYWORD SCM
1037 _scm_from_sockaddr (const scm_t_max_sockaddr
*address
, unsigned addr_size
,
1040 SCM result
= SCM_EOL
;
1041 short int fam
= ((struct sockaddr
*) address
)->sa_family
;
1047 const struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
1049 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
1051 SCM_SIMPLE_VECTOR_SET(result
, 0,
1052 scm_from_short (fam
));
1053 SCM_SIMPLE_VECTOR_SET(result
, 1,
1054 scm_from_ulong (ntohl (nad
->sin_addr
.s_addr
)));
1055 SCM_SIMPLE_VECTOR_SET(result
, 2,
1056 scm_from_ushort (ntohs (nad
->sin_port
)));
1062 const struct sockaddr_in6
*nad
= (struct sockaddr_in6
*) address
;
1064 result
= scm_c_make_vector (5, SCM_UNSPECIFIED
);
1065 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1066 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_ipv6 (nad
->sin6_addr
.s6_addr
));
1067 SCM_SIMPLE_VECTOR_SET(result
, 2, scm_from_ushort (ntohs (nad
->sin6_port
)));
1068 SCM_SIMPLE_VECTOR_SET(result
, 3, scm_from_uint32 (nad
->sin6_flowinfo
));
1069 #ifdef HAVE_SIN6_SCOPE_ID
1070 SCM_SIMPLE_VECTOR_SET(result
, 4, scm_from_ulong (nad
->sin6_scope_id
));
1072 SCM_SIMPLE_VECTOR_SET(result
, 4, SCM_INUM0
);
1077 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1080 const struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
1082 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
1084 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1085 /* When addr_size is not enough to cover sun_path, do not try
1087 if (addr_size
<= offsetof (struct sockaddr_un
, sun_path
))
1088 SCM_SIMPLE_VECTOR_SET(result
, 1, SCM_BOOL_F
);
1090 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_locale_string (nad
->sun_path
));
1095 result
= SCM_UNSPECIFIED
;
1096 scm_misc_error (proc
, "unrecognised address family: ~A",
1097 scm_list_1 (scm_from_int (fam
)));
1103 /* The publicly-visible function. Return a Scheme object representing
1104 ADDRESS, an address of ADDR_SIZE bytes. */
1106 scm_from_sockaddr (const struct sockaddr
*address
, unsigned addr_size
)
1108 return (_scm_from_sockaddr ((scm_t_max_sockaddr
*) address
,
1109 addr_size
, "scm_from_sockaddr"));
1112 /* Convert ADDRESS, an address object returned by either
1113 `scm_from_sockaddr ()' or `scm_make_socket_address ()', into its C
1114 representation. On success, a non-NULL pointer is returned and
1115 ADDRESS_SIZE is updated to the actual size (in bytes) of the returned
1116 address. The result must eventually be freed using `free ()'. */
1118 scm_to_sockaddr (SCM address
, size_t *address_size
)
1119 #define FUNC_NAME "scm_to_sockaddr"
1122 struct sockaddr
*c_address
= NULL
;
1124 SCM_VALIDATE_VECTOR (1, address
);
1127 family
= scm_to_short (SCM_SIMPLE_VECTOR_REF (address
, 0));
1133 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 3)
1134 scm_misc_error (FUNC_NAME
,
1135 "invalid inet address representation: ~A",
1136 scm_list_1 (address
));
1139 struct sockaddr_in c_inet
;
1141 memset (&c_inet
, '\0', sizeof (struct sockaddr_in
));
1143 #ifdef HAVE_STRUCT_SOCKADDR_IN_SIN_LEN
1144 c_inet
.sin_len
= sizeof (struct sockaddr_in
);
1147 c_inet
.sin_addr
.s_addr
=
1148 htonl (scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 1)));
1150 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1151 c_inet
.sin_family
= AF_INET
;
1153 *address_size
= sizeof (c_inet
);
1154 c_address
= scm_malloc (sizeof (c_inet
));
1155 memcpy (c_address
, &c_inet
, sizeof (c_inet
));
1164 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 5)
1165 scm_misc_error (FUNC_NAME
, "invalid inet6 address representation: ~A",
1166 scm_list_1 (address
));
1169 struct sockaddr_in6 c_inet6
;
1171 scm_to_ipv6 (c_inet6
.sin6_addr
.s6_addr
,
1172 SCM_SIMPLE_VECTOR_REF (address
, 1));
1174 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1175 c_inet6
.sin6_flowinfo
=
1176 scm_to_uint32 (SCM_SIMPLE_VECTOR_REF (address
, 3));
1177 #ifdef HAVE_SIN6_SCOPE_ID
1178 c_inet6
.sin6_scope_id
=
1179 scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 4));
1182 c_inet6
.sin6_family
= AF_INET6
;
1184 *address_size
= sizeof (c_inet6
);
1185 c_address
= scm_malloc (sizeof (c_inet6
));
1186 memcpy (c_address
, &c_inet6
, sizeof (c_inet6
));
1193 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1196 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 2)
1197 scm_misc_error (FUNC_NAME
, "invalid unix address representation: ~A",
1198 scm_list_1 (address
));
1202 size_t path_len
= 0;
1204 path
= SCM_SIMPLE_VECTOR_REF (address
, 1);
1205 if (!scm_is_string (path
) && !scm_is_false (path
))
1206 scm_misc_error (FUNC_NAME
, "invalid unix address "
1207 "path: ~A", scm_list_1 (path
));
1210 struct sockaddr_un c_unix
;
1212 if (scm_is_false (path
))
1215 path_len
= scm_c_string_length (path
);
1217 #ifdef UNIX_PATH_MAX
1218 if (path_len
>= UNIX_PATH_MAX
)
1220 /* We can hope that this limit will eventually vanish, at least on GNU.
1221 However, currently, while glibc doesn't define `UNIX_PATH_MAX', it
1222 documents it has being limited to 108 bytes. */
1223 if (path_len
>= sizeof (c_unix
.sun_path
))
1225 scm_misc_error (FUNC_NAME
, "unix address path "
1226 "too long: ~A", scm_list_1 (path
));
1231 scm_to_locale_stringbuf (path
, c_unix
.sun_path
,
1232 #ifdef UNIX_PATH_MAX
1235 sizeof (c_unix
.sun_path
));
1237 c_unix
.sun_path
[path_len
] = '\0';
1240 if (strlen (c_unix
.sun_path
) != path_len
)
1241 scm_misc_error (FUNC_NAME
, "unix address path "
1242 "contains nul characters: ~A",
1246 c_unix
.sun_path
[0] = '\0';
1248 c_unix
.sun_family
= AF_UNIX
;
1250 *address_size
= SUN_LEN (&c_unix
);
1251 c_address
= scm_malloc (sizeof (c_unix
));
1252 memcpy (c_address
, &c_unix
, sizeof (c_unix
));
1262 scm_misc_error (FUNC_NAME
, "unrecognised address family: ~A",
1263 scm_list_1 (scm_from_ushort (family
)));
1271 /* Return a newly-allocated `sockaddr' structure that reflects ADDRESS, being
1272 an address of family FAMILY, with the family-specific parameters ARGS (see
1273 the description of `connect' for details). The returned structure may be
1274 freed using `free ()'. */
1276 scm_c_make_socket_address (SCM family
, SCM address
, SCM args
,
1277 size_t *address_size
)
1279 struct sockaddr
*soka
;
1281 soka
= scm_fill_sockaddr (scm_to_ushort (family
), address
, &args
, 1,
1282 "scm_c_make_socket_address", address_size
);
1287 SCM_DEFINE (scm_make_socket_address
, "make-socket-address", 2, 0, 1,
1288 (SCM family
, SCM address
, SCM args
),
1289 "Return a Scheme address object that reflects @var{address}, "
1290 "being an address of family @var{family}, with the "
1291 "family-specific parameters @var{args} (see the description of "
1292 "@code{connect} for details).")
1293 #define FUNC_NAME s_scm_make_socket_address
1295 SCM result
= SCM_BOOL_F
;
1296 struct sockaddr
*c_address
;
1297 size_t c_address_size
;
1299 c_address
= scm_c_make_socket_address (family
, address
, args
,
1301 if (c_address
!= NULL
)
1303 result
= scm_from_sockaddr (c_address
, c_address_size
);
1312 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
1314 "Accept a connection on a bound, listening socket.\n"
1316 "are no pending connections in the queue, wait until\n"
1317 "one is available unless the non-blocking option has been\n"
1318 "set on the socket.\n\n"
1319 "The return value is a\n"
1320 "pair in which the @emph{car} is a new socket port for the\n"
1322 "the @emph{cdr} is an object with address information about the\n"
1323 "client which initiated the connection.\n\n"
1324 "@var{sock} does not become part of the\n"
1325 "connection and will continue to accept new requests.")
1326 #define FUNC_NAME s_scm_accept
1332 socklen_t addr_size
= MAX_ADDR_SIZE
;
1333 scm_t_max_sockaddr addr
;
1335 sock
= SCM_COERCE_OUTPORT (sock
);
1336 SCM_VALIDATE_OPFPORT (1, sock
);
1337 fd
= SCM_FPORT_FDES (sock
);
1338 newfd
= accept (fd
, (struct sockaddr
*) &addr
, &addr_size
);
1341 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
1342 address
= _scm_from_sockaddr (&addr
, addr_size
,
1345 return scm_cons (newsock
, address
);
1349 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
1351 "Return the address of @var{sock}, in the same form as the\n"
1352 "object returned by @code{accept}. On many systems the address\n"
1353 "of a socket in the @code{AF_FILE} namespace cannot be read.")
1354 #define FUNC_NAME s_scm_getsockname
1357 socklen_t addr_size
= MAX_ADDR_SIZE
;
1358 scm_t_max_sockaddr addr
;
1360 sock
= SCM_COERCE_OUTPORT (sock
);
1361 SCM_VALIDATE_OPFPORT (1, sock
);
1362 fd
= SCM_FPORT_FDES (sock
);
1363 if (getsockname (fd
, (struct sockaddr
*) &addr
, &addr_size
) == -1)
1366 return _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1370 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
1372 "Return the address that @var{sock}\n"
1373 "is connected to, in the same form as the object returned by\n"
1374 "@code{accept}. On many systems the address of a socket in the\n"
1375 "@code{AF_FILE} namespace cannot be read.")
1376 #define FUNC_NAME s_scm_getpeername
1379 socklen_t addr_size
= MAX_ADDR_SIZE
;
1380 scm_t_max_sockaddr addr
;
1382 sock
= SCM_COERCE_OUTPORT (sock
);
1383 SCM_VALIDATE_OPFPORT (1, sock
);
1384 fd
= SCM_FPORT_FDES (sock
);
1385 if (getpeername (fd
, (struct sockaddr
*) &addr
, &addr_size
) == -1)
1388 return _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1392 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
1393 (SCM sock
, SCM buf
, SCM flags
),
1394 "Receive data from a socket port.\n"
1395 "@var{sock} must already\n"
1396 "be bound to the address from which data is to be received.\n"
1397 "@var{buf} is a bytevector into which\n"
1398 "the data will be written. The size of @var{buf} limits\n"
1400 "data which can be received: in the case of packet\n"
1401 "protocols, if a packet larger than this limit is encountered\n"
1403 "will be irrevocably lost.\n\n"
1404 "The optional @var{flags} argument is a value or\n"
1405 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1406 "The value returned is the number of bytes read from the\n"
1408 "Note that the data is read directly from the socket file\n"
1410 "any unread buffered port data is ignored.")
1411 #define FUNC_NAME s_scm_recv
1415 SCM_VALIDATE_OPFPORT (1, sock
);
1417 if (SCM_UNBNDP (flags
))
1420 flg
= scm_to_int (flags
);
1421 fd
= SCM_FPORT_FDES (sock
);
1423 #if SCM_ENABLE_DEPRECATED == 1
1424 if (SCM_UNLIKELY (scm_is_string (buf
)))
1430 scm_c_issue_deprecation_warning
1431 ("Passing a string to `recv!' is deprecated, "
1432 "use a bytevector instead.");
1434 len
= scm_i_string_length (buf
);
1435 msg
= scm_i_make_string (len
, &dest
, 0);
1436 SCM_SYSCALL (rv
= recv (fd
, dest
, len
, flg
));
1437 scm_string_copy_x (buf
, scm_from_int (0),
1438 msg
, scm_from_int (0), scm_from_size_t (len
));
1443 SCM_VALIDATE_BYTEVECTOR (1, buf
);
1445 SCM_SYSCALL (rv
= recv (fd
,
1446 SCM_BYTEVECTOR_CONTENTS (buf
),
1447 SCM_BYTEVECTOR_LENGTH (buf
),
1451 if (SCM_UNLIKELY (rv
== -1))
1454 scm_remember_upto_here (buf
);
1455 return scm_from_int (rv
);
1459 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
1460 (SCM sock
, SCM message
, SCM flags
),
1461 "Transmit bytevector @var{message} on socket port @var{sock}.\n"
1462 "@var{sock} must already be bound to a destination address. The\n"
1463 "value returned is the number of bytes transmitted --\n"
1464 "it's possible for\n"
1465 "this to be less than the length of @var{message}\n"
1466 "if the socket is\n"
1467 "set to be non-blocking. The optional @var{flags} argument\n"
1469 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1470 "Note that the data is written directly to the socket\n"
1471 "file descriptor:\n"
1472 "any unflushed buffered port data is ignored.\n\n"
1473 "This operation is defined only for strings containing codepoints\n"
1475 #define FUNC_NAME s_scm_send
1479 sock
= SCM_COERCE_OUTPORT (sock
);
1480 SCM_VALIDATE_OPFPORT (1, sock
);
1482 if (SCM_UNBNDP (flags
))
1485 flg
= scm_to_int (flags
);
1487 fd
= SCM_FPORT_FDES (sock
);
1489 #if SCM_ENABLE_DEPRECATED == 1
1490 if (SCM_UNLIKELY (scm_is_string (message
)))
1492 scm_c_issue_deprecation_warning
1493 ("Passing a string to `send' is deprecated, "
1494 "use a bytevector instead.");
1496 /* If the string is wide, see if it can be coerced into a narrow
1498 if (!scm_i_is_narrow_string (message
)
1499 || !scm_i_try_narrow_string (message
))
1500 SCM_MISC_ERROR ("the message string is not 8-bit: ~s",
1501 scm_list_1 (message
));
1503 SCM_SYSCALL (rv
= send (fd
,
1504 scm_i_string_chars (message
),
1505 scm_i_string_length (message
),
1511 SCM_VALIDATE_BYTEVECTOR (1, message
);
1513 SCM_SYSCALL (rv
= send (fd
,
1514 SCM_BYTEVECTOR_CONTENTS (message
),
1515 SCM_BYTEVECTOR_LENGTH (message
),
1522 scm_remember_upto_here_1 (message
);
1523 return scm_from_int (rv
);
1527 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
1528 (SCM sock
, SCM buf
, SCM flags
, SCM start
, SCM end
),
1529 "Receive data from socket port @var{sock} (which must be already\n"
1530 "bound), returning the originating address as well as the data.\n"
1531 "This is usually for use on datagram sockets, but can be used on\n"
1532 "stream-oriented sockets too.\n"
1534 "The data received is stored in bytevector @var{buf}, using\n"
1535 "either the whole bytevector or just the region between the optional\n"
1536 "@var{start} and @var{end} positions. The size of @var{buf}\n"
1537 "limits the amount of data that can be received. For datagram\n"
1538 "protocols, if a packet larger than this is received then excess\n"
1539 "bytes are irrevocably lost.\n"
1541 "The return value is a pair. The @code{car} is the number of\n"
1542 "bytes read. The @code{cdr} is a socket address object which is\n"
1543 "where the data came from, or @code{#f} if the origin is\n"
1546 "The optional @var{flags} argument is a or bitwise OR\n"
1547 "(@code{logior}) of @code{MSG_OOB}, @code{MSG_PEEK},\n"
1548 "@code{MSG_DONTROUTE} etc.\n"
1550 "Data is read directly from the socket file descriptor, any\n"
1551 "buffered port data is ignored.\n"
1553 "On a GNU/Linux system @code{recvfrom!} is not multi-threading,\n"
1554 "all threads stop while a @code{recvfrom!} call is in progress.\n"
1555 "An application may need to use @code{select}, @code{O_NONBLOCK}\n"
1556 "or @code{MSG_DONTWAIT} to avoid this.")
1557 #define FUNC_NAME s_scm_recvfrom
1561 size_t offset
, cend
;
1562 socklen_t addr_size
= MAX_ADDR_SIZE
;
1563 scm_t_max_sockaddr addr
;
1565 SCM_VALIDATE_OPFPORT (1, sock
);
1566 fd
= SCM_FPORT_FDES (sock
);
1568 if (SCM_UNBNDP (flags
))
1571 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
1573 ((struct sockaddr
*) &addr
)->sa_family
= AF_UNSPEC
;
1575 #if SCM_ENABLE_DEPRECATED == 1
1576 if (SCM_UNLIKELY (scm_is_string (buf
)))
1580 scm_c_issue_deprecation_warning
1581 ("Passing a string to `recvfrom!' is deprecated, "
1582 "use a bytevector instead.");
1584 scm_i_get_substring_spec (scm_i_string_length (buf
),
1585 start
, &offset
, end
, &cend
);
1587 buf
= scm_i_string_start_writing (buf
);
1588 cbuf
= scm_i_string_writable_chars (buf
);
1590 SCM_SYSCALL (rv
= recvfrom (fd
, cbuf
+ offset
,
1592 (struct sockaddr
*) &addr
, &addr_size
));
1593 scm_i_string_stop_writing ();
1598 SCM_VALIDATE_BYTEVECTOR (1, buf
);
1600 if (SCM_UNBNDP (start
))
1603 offset
= scm_to_size_t (start
);
1605 if (SCM_UNBNDP (end
))
1606 cend
= SCM_BYTEVECTOR_LENGTH (buf
);
1609 cend
= scm_to_size_t (end
);
1610 if (SCM_UNLIKELY (cend
>= SCM_BYTEVECTOR_LENGTH (buf
)
1612 scm_out_of_range (FUNC_NAME
, end
);
1615 SCM_SYSCALL (rv
= recvfrom (fd
,
1616 SCM_BYTEVECTOR_CONTENTS (buf
) + offset
,
1618 (struct sockaddr
*) &addr
, &addr_size
));
1624 /* `recvfrom' does not necessarily return an address. Usually nothing
1625 is returned for stream sockets. */
1626 if (((struct sockaddr
*) &addr
)->sa_family
!= AF_UNSPEC
)
1627 address
= _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1629 address
= SCM_BOOL_F
;
1631 scm_remember_upto_here_1 (buf
);
1633 return scm_cons (scm_from_int (rv
), address
);
1637 SCM_DEFINE (scm_sendto
, "sendto", 3, 1, 1,
1638 (SCM sock
, SCM message
, SCM fam_or_sockaddr
, SCM address
, SCM args_and_flags
),
1639 "Transmit bytevector @var{message} on socket port\n"
1641 "destination address is specified using the @var{fam_or_sockaddr},\n"
1642 "@var{address} and\n"
1643 "@var{args_and_flags} arguments, or just a socket address object "
1644 "returned by @code{make-socket-address}, in a similar way to the\n"
1645 "@code{connect} procedure. @var{args_and_flags} contains\n"
1646 "the usual connection arguments optionally followed by\n"
1647 "a flags argument, which is a value or\n"
1648 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1649 "The value returned is the number of bytes transmitted --\n"
1650 "it's possible for\n"
1651 "this to be less than the length of @var{message} if the\n"
1653 "set to be non-blocking.\n"
1654 "Note that the data is written directly to the socket\n"
1655 "file descriptor:\n"
1656 "any unflushed buffered port data is ignored.\n"
1657 "This operation is defined only for strings containing codepoints\n"
1659 #define FUNC_NAME s_scm_sendto
1662 struct sockaddr
*soka
;
1665 sock
= SCM_COERCE_OUTPORT (sock
);
1666 SCM_VALIDATE_FPORT (1, sock
);
1667 fd
= SCM_FPORT_FDES (sock
);
1669 if (!scm_is_number (fam_or_sockaddr
))
1671 /* FAM_OR_SOCKADDR must actually be a `socket address' object. This
1672 means that the following arguments, i.e. ADDRESS and those listed in
1673 ARGS_AND_FLAGS, are the `MSG_' flags. */
1674 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
1675 if (!scm_is_eq (address
, SCM_UNDEFINED
))
1676 args_and_flags
= scm_cons (address
, args_and_flags
);
1679 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
1680 &args_and_flags
, 3, FUNC_NAME
, &size
);
1682 if (scm_is_null (args_and_flags
))
1686 SCM_VALIDATE_CONS (5, args_and_flags
);
1687 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
1690 #if SCM_ENABLE_DEPRECATED == 1
1691 if (SCM_UNLIKELY (scm_is_string (message
)))
1693 scm_c_issue_deprecation_warning
1694 ("Passing a string to `sendto' is deprecated, "
1695 "use a bytevector instead.");
1697 /* If the string is wide, see if it can be coerced into a narrow
1699 if (!scm_i_is_narrow_string (message
)
1700 || !scm_i_try_narrow_string (message
))
1701 SCM_MISC_ERROR ("the message string is not 8-bit: ~s",
1702 scm_list_1 (message
));
1704 SCM_SYSCALL (rv
= sendto (fd
,
1705 scm_i_string_chars (message
),
1706 scm_i_string_length (message
),
1712 SCM_VALIDATE_BYTEVECTOR (1, message
);
1714 SCM_SYSCALL (rv
= sendto (fd
,
1715 SCM_BYTEVECTOR_CONTENTS (message
),
1716 SCM_BYTEVECTOR_LENGTH (message
),
1722 int save_errno
= errno
;
1729 scm_remember_upto_here_1 (message
);
1730 return scm_from_int (rv
);
1739 /* protocol families. */
1741 scm_c_define ("AF_UNSPEC", scm_from_int (AF_UNSPEC
));
1744 scm_c_define ("AF_UNIX", scm_from_int (AF_UNIX
));
1747 scm_c_define ("AF_INET", scm_from_int (AF_INET
));
1750 scm_c_define ("AF_INET6", scm_from_int (AF_INET6
));
1754 scm_c_define ("PF_UNSPEC", scm_from_int (PF_UNSPEC
));
1757 scm_c_define ("PF_UNIX", scm_from_int (PF_UNIX
));
1760 scm_c_define ("PF_INET", scm_from_int (PF_INET
));
1763 scm_c_define ("PF_INET6", scm_from_int (PF_INET6
));
1766 /* standard addresses. */
1768 scm_c_define ("INADDR_ANY", scm_from_ulong (INADDR_ANY
));
1770 #ifdef INADDR_BROADCAST
1771 scm_c_define ("INADDR_BROADCAST", scm_from_ulong (INADDR_BROADCAST
));
1774 scm_c_define ("INADDR_NONE", scm_from_ulong (INADDR_NONE
));
1776 #ifdef INADDR_LOOPBACK
1777 scm_c_define ("INADDR_LOOPBACK", scm_from_ulong (INADDR_LOOPBACK
));
1782 SOCK_PACKET is deliberately omitted, the GNU/Linux socket(2) and
1783 packet(7) advise that it's obsolete and strongly deprecated. */
1786 scm_c_define ("SOCK_STREAM", scm_from_int (SOCK_STREAM
));
1789 scm_c_define ("SOCK_DGRAM", scm_from_int (SOCK_DGRAM
));
1791 #ifdef SOCK_SEQPACKET
1792 scm_c_define ("SOCK_SEQPACKET", scm_from_int (SOCK_SEQPACKET
));
1795 scm_c_define ("SOCK_RAW", scm_from_int (SOCK_RAW
));
1798 scm_c_define ("SOCK_RDM", scm_from_int (SOCK_RDM
));
1801 /* setsockopt level.
1803 SOL_IP, SOL_TCP and SOL_UDP are defined on gnu/linux, but not on for
1804 instance NetBSD. We define IPPROTOs because that's what the posix spec
1805 shows in its example at
1807 http://www.opengroup.org/onlinepubs/007904975/functions/getsockopt.html
1810 scm_c_define ("SOL_SOCKET", scm_from_int (SOL_SOCKET
));
1813 scm_c_define ("IPPROTO_IP", scm_from_int (IPPROTO_IP
));
1816 scm_c_define ("IPPROTO_TCP", scm_from_int (IPPROTO_TCP
));
1819 scm_c_define ("IPPROTO_UDP", scm_from_int (IPPROTO_UDP
));
1822 /* setsockopt names. */
1824 scm_c_define ("SO_DEBUG", scm_from_int (SO_DEBUG
));
1827 scm_c_define ("SO_REUSEADDR", scm_from_int (SO_REUSEADDR
));
1830 scm_c_define ("SO_STYLE", scm_from_int (SO_STYLE
));
1833 scm_c_define ("SO_TYPE", scm_from_int (SO_TYPE
));
1836 scm_c_define ("SO_ERROR", scm_from_int (SO_ERROR
));
1839 scm_c_define ("SO_DONTROUTE", scm_from_int (SO_DONTROUTE
));
1842 scm_c_define ("SO_BROADCAST", scm_from_int (SO_BROADCAST
));
1845 scm_c_define ("SO_SNDBUF", scm_from_int (SO_SNDBUF
));
1848 scm_c_define ("SO_RCVBUF", scm_from_int (SO_RCVBUF
));
1851 scm_c_define ("SO_KEEPALIVE", scm_from_int (SO_KEEPALIVE
));
1854 scm_c_define ("SO_OOBINLINE", scm_from_int (SO_OOBINLINE
));
1857 scm_c_define ("SO_NO_CHECK", scm_from_int (SO_NO_CHECK
));
1860 scm_c_define ("SO_PRIORITY", scm_from_int (SO_PRIORITY
));
1863 scm_c_define ("SO_LINGER", scm_from_int (SO_LINGER
));
1866 /* recv/send options. */
1868 scm_c_define ("MSG_DONTWAIT", scm_from_int (MSG_DONTWAIT
));
1871 scm_c_define ("MSG_OOB", scm_from_int (MSG_OOB
));
1874 scm_c_define ("MSG_PEEK", scm_from_int (MSG_PEEK
));
1876 #ifdef MSG_DONTROUTE
1877 scm_c_define ("MSG_DONTROUTE", scm_from_int (MSG_DONTROUTE
));
1881 scm_i_init_socket_Win32 ();
1884 #ifdef IP_ADD_MEMBERSHIP
1885 scm_c_define ("IP_ADD_MEMBERSHIP", scm_from_int (IP_ADD_MEMBERSHIP
));
1886 scm_c_define ("IP_DROP_MEMBERSHIP", scm_from_int (IP_DROP_MEMBERSHIP
));
1889 #ifdef IP_MULTICAST_TTL
1890 scm_c_define ("IP_MULTICAST_TTL", scm_from_int ( IP_MULTICAST_TTL
));
1893 #ifdef IP_MULTICAST_IF
1894 scm_c_define ("IP_MULTICAST_IF", scm_from_int ( IP_MULTICAST_IF
));
1897 scm_add_feature ("socket");
1899 #include "libguile/socket.x"