1 /* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006 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
5 * License as published by the Free Software Foundation; either
6 * version 2.1 of the License, or (at your option) any later version.
8 * This library is distributed in the hope that it will be useful,
9 * but 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 02110-1301 USA
28 #include "libguile/_scm.h"
29 #include "libguile/unif.h"
30 #include "libguile/feature.h"
31 #include "libguile/fports.h"
32 #include "libguile/strings.h"
33 #include "libguile/vectors.h"
34 #include "libguile/dynwind.h"
36 #include "libguile/validate.h"
37 #include "libguile/socket.h"
40 #include "win32-socket.h"
52 #include <sys/types.h>
53 #ifdef HAVE_WINSOCK2_H
56 #include <sys/socket.h>
57 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
60 #include <netinet/in.h>
62 #include <arpa/inet.h>
65 #if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
66 #define SUN_LEN(ptr) ((size_t) (((struct sockaddr_un *) 0)->sun_path) \
67 + strlen ((ptr)->sun_path))
72 SCM_DEFINE (scm_htons
, "htons", 1, 0, 0,
74 "Convert a 16 bit quantity from host to network byte ordering.\n"
75 "@var{value} is packed into 2 bytes, which are then converted\n"
76 "and returned as a new integer.")
77 #define FUNC_NAME s_scm_htons
79 return scm_from_ushort (htons (scm_to_ushort (value
)));
83 SCM_DEFINE (scm_ntohs
, "ntohs", 1, 0, 0,
85 "Convert a 16 bit quantity from network to host byte ordering.\n"
86 "@var{value} is packed into 2 bytes, which are then converted\n"
87 "and returned as a new integer.")
88 #define FUNC_NAME s_scm_ntohs
90 return scm_from_ushort (ntohs (scm_to_ushort (value
)));
94 SCM_DEFINE (scm_htonl
, "htonl", 1, 0, 0,
96 "Convert a 32 bit quantity from host to network byte ordering.\n"
97 "@var{value} is packed into 4 bytes, which are then converted\n"
98 "and returned as a new integer.")
99 #define FUNC_NAME s_scm_htonl
101 return scm_from_ulong (htonl (scm_to_uint32 (value
)));
105 SCM_DEFINE (scm_ntohl
, "ntohl", 1, 0, 0,
107 "Convert a 32 bit quantity from network to host byte ordering.\n"
108 "@var{value} is packed into 4 bytes, which are then converted\n"
109 "and returned as a new integer.")
110 #define FUNC_NAME s_scm_ntohl
112 return scm_from_ulong (ntohl (scm_to_uint32 (value
)));
116 #ifndef HAVE_INET_ATON
117 /* for our definition in inet_aton.c, not usually needed. */
118 extern int inet_aton ();
121 SCM_DEFINE (scm_inet_aton
, "inet-aton", 1, 0, 0,
123 "Convert an IPv4 Internet address from printable string\n"
124 "(dotted decimal notation) to an integer. E.g.,\n\n"
126 "(inet-aton \"127.0.0.1\") @result{} 2130706433\n"
128 #define FUNC_NAME s_scm_inet_aton
134 c_address
= scm_to_locale_string (address
);
135 rv
= inet_aton (c_address
, &soka
);
138 SCM_MISC_ERROR ("bad address", SCM_EOL
);
139 return scm_from_ulong (ntohl (soka
.s_addr
));
144 SCM_DEFINE (scm_inet_ntoa
, "inet-ntoa", 1, 0, 0,
146 "Convert an IPv4 Internet address to a printable\n"
147 "(dotted decimal notation) string. E.g.,\n\n"
149 "(inet-ntoa 2130706433) @result{} \"127.0.0.1\"\n"
151 #define FUNC_NAME s_scm_inet_ntoa
156 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, inetid
));
157 s
= inet_ntoa (addr
);
158 answer
= scm_from_locale_string (s
);
163 #ifdef HAVE_INET_NETOF
164 SCM_DEFINE (scm_inet_netof
, "inet-netof", 1, 0, 0,
166 "Return the network number part of the given IPv4\n"
167 "Internet address. E.g.,\n\n"
169 "(inet-netof 2130706433) @result{} 127\n"
171 #define FUNC_NAME s_scm_inet_netof
174 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
175 return scm_from_ulong (inet_netof (addr
));
180 #ifdef HAVE_INET_LNAOF
181 SCM_DEFINE (scm_lnaof
, "inet-lnaof", 1, 0, 0,
183 "Return the local-address-with-network part of the given\n"
184 "IPv4 Internet address, using the obsolete class A/B/C system.\n"
187 "(inet-lnaof 2130706433) @result{} 1\n"
189 #define FUNC_NAME s_scm_lnaof
192 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
193 return scm_from_ulong (inet_lnaof (addr
));
198 #ifdef HAVE_INET_MAKEADDR
199 SCM_DEFINE (scm_inet_makeaddr
, "inet-makeaddr", 2, 0, 0,
201 "Make an IPv4 Internet address by combining the network number\n"
202 "@var{net} with the local-address-within-network number\n"
203 "@var{lna}. E.g.,\n\n"
205 "(inet-makeaddr 127 1) @result{} 2130706433\n"
207 #define FUNC_NAME s_scm_inet_makeaddr
210 unsigned long netnum
;
211 unsigned long lnanum
;
213 netnum
= SCM_NUM2ULONG (1, net
);
214 lnanum
= SCM_NUM2ULONG (2, lna
);
215 addr
= inet_makeaddr (netnum
, lnanum
);
216 return scm_from_ulong (ntohl (addr
.s_addr
));
223 /* flip a 128 bit IPv6 address between host and network order. */
224 #ifdef WORDS_BIGENDIAN
225 #define FLIP_NET_HOST_128(addr)
227 #define FLIP_NET_HOST_128(addr)\
231 for (i = 0; i < 8; i++)\
233 scm_t_uint8 c = (addr)[i];\
235 (addr)[i] = (addr)[15 - i];\
241 #ifdef WORDS_BIGENDIAN
242 #define FLIPCPY_NET_HOST_128(dest, src) memcpy (dest, src, 16)
244 #define FLIPCPY_NET_HOST_128(dest, src) \
246 const scm_t_uint8 *tmp_srcp = (src) + 15; \
247 scm_t_uint8 *tmp_destp = (dest); \
250 *tmp_destp++ = *tmp_srcp--; \
251 } while (tmp_srcp != (src)); \
256 #if (SIZEOF_SCM_T_BITS * SCM_CHAR_BIT) > 128
257 #error "Assumption that scm_t_bits <= 128 bits has been violated."
260 #if (SIZEOF_UNSIGNED_LONG * SCM_CHAR_BIT) > 128
261 #error "Assumption that unsigned long <= 128 bits has been violated."
264 #if (SIZEOF_UNSIGNED_LONG_LONG * SCM_CHAR_BIT) > 128
265 #error "Assumption that unsigned long long <= 128 bits has been violated."
268 /* convert a 128 bit IPv6 address in network order to a host ordered
271 scm_from_ipv6 (const scm_t_uint8
*src
)
273 SCM result
= scm_i_mkbig ();
274 mpz_import (SCM_I_BIG_MPZ (result
),
276 1, /* big-endian chunk ordering */
277 16, /* chunks are 16 bytes long */
278 1, /* big-endian byte ordering */
279 0, /* "nails" -- leading unused bits per chunk */
281 return scm_i_normbig (result
);
284 /* convert a host ordered SCM integer to a 128 bit IPv6 address in
287 scm_to_ipv6 (scm_t_uint8 dst
[16], SCM src
)
289 if (SCM_I_INUMP (src
))
291 scm_t_signed_bits n
= SCM_I_INUM (src
);
293 scm_out_of_range (NULL
, src
);
294 #ifdef WORDS_BIGENDIAN
295 memset (dst
, 0, 16 - sizeof (scm_t_signed_bits
));
296 memcpy (dst
+ (16 - sizeof (scm_t_signed_bits
)),
298 sizeof (scm_t_signed_bits
));
300 memset (dst
+ sizeof (scm_t_signed_bits
),
302 16 - sizeof (scm_t_signed_bits
));
303 /* FIXME: this pair of ops is kinda wasteful -- should rewrite as
304 a single loop perhaps, similar to the handling of bignums. */
305 memcpy (dst
, &n
, sizeof (scm_t_signed_bits
));
306 FLIP_NET_HOST_128 (dst
);
309 else if (SCM_BIGP (src
))
313 if ((mpz_sgn (SCM_I_BIG_MPZ (src
)) < 0)
314 || mpz_sizeinbase (SCM_I_BIG_MPZ (src
), 2) > 128)
315 scm_out_of_range (NULL
, src
);
320 1, /* big-endian chunk ordering */
321 16, /* chunks are 16 bytes long */
322 1, /* big-endian byte ordering */
323 0, /* "nails" -- leading unused bits per chunk */
324 SCM_I_BIG_MPZ (src
));
325 scm_remember_upto_here_1 (src
);
328 scm_wrong_type_arg (NULL
, 0, src
);
331 #ifdef HAVE_INET_PTON
332 SCM_DEFINE (scm_inet_pton
, "inet-pton", 2, 0, 0,
333 (SCM family
, SCM address
),
334 "Convert a string containing a printable network address to\n"
335 "an integer address. Note that unlike the C version of this\n"
337 "the result is an integer with normal host byte ordering.\n"
338 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
340 "(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
341 "(inet-pton AF_INET6 \"::1\") @result{} 1\n"
343 #define FUNC_NAME s_scm_inet_pton
350 af
= scm_to_int (family
);
351 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
352 src
= scm_to_locale_string (address
);
353 rv
= inet_pton (af
, src
, dst
);
360 SCM_MISC_ERROR ("Bad address", SCM_EOL
);
362 return scm_from_ulong (ntohl (*(scm_t_uint32
*) dst
));
364 return scm_from_ipv6 ((scm_t_uint8
*) dst
);
369 #ifdef HAVE_INET_NTOP
370 SCM_DEFINE (scm_inet_ntop
, "inet-ntop", 2, 0, 0,
371 (SCM family
, SCM address
),
372 "Convert a network address into a printable string.\n"
373 "Note that unlike the C version of this function,\n"
374 "the input is an integer with normal host byte ordering.\n"
375 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
377 "(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
378 "(inet-ntop AF_INET6 (- (expt 2 128) 1)) @result{}\n"
379 "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\n"
381 #define FUNC_NAME s_scm_inet_ntop
384 #ifdef INET6_ADDRSTRLEN
385 char dst
[INET6_ADDRSTRLEN
];
391 af
= scm_to_int (family
);
392 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
394 *(scm_t_uint32
*) addr6
= htonl (SCM_NUM2ULONG (2, address
));
396 scm_to_ipv6 ((scm_t_uint8
*) addr6
, address
);
397 if (inet_ntop (af
, &addr6
, dst
, sizeof dst
) == NULL
)
399 return scm_from_locale_string (dst
);
404 #endif /* HAVE_IPV6 */
406 SCM_SYMBOL (sym_socket
, "socket");
408 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
410 SCM_DEFINE (scm_socket
, "socket", 3, 0, 0,
411 (SCM family
, SCM style
, SCM proto
),
412 "Return a new socket port of the type specified by @var{family},\n"
413 "@var{style} and @var{proto}. All three parameters are\n"
414 "integers. Supported values for @var{family} are\n"
415 "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
416 "Typical values for @var{style} are @code{SOCK_STREAM},\n"
417 "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
418 "@var{proto} can be obtained from a protocol name using\n"
419 "@code{getprotobyname}. A value of zero specifies the default\n"
420 "protocol, which is usually right.\n\n"
421 "A single socket port cannot by used for communication until it\n"
422 "has been connected to another socket.")
423 #define FUNC_NAME s_scm_socket
427 fd
= socket (scm_to_int (family
),
432 return SCM_SOCK_FD_TO_PORT (fd
);
436 #ifdef HAVE_SOCKETPAIR
437 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
438 (SCM family
, SCM style
, SCM proto
),
439 "Return a pair of connected (but unnamed) socket ports of the\n"
440 "type specified by @var{family}, @var{style} and @var{proto}.\n"
441 "Many systems support only socket pairs of the @code{AF_UNIX}\n"
442 "family. Zero is likely to be the only meaningful value for\n"
444 #define FUNC_NAME s_scm_socketpair
449 fam
= scm_to_int (family
);
451 if (socketpair (fam
, scm_to_int (style
), scm_to_int (proto
), fd
) == -1)
454 return scm_cons (SCM_SOCK_FD_TO_PORT (fd
[0]), SCM_SOCK_FD_TO_PORT (fd
[1]));
459 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
460 (SCM sock
, SCM level
, SCM optname
),
461 "Return an option value from socket port @var{sock}.\n"
463 "@var{level} is an integer specifying a protocol layer, either\n"
464 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
465 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
466 "(@pxref{Network Databases}).\n"
468 "@defvar SOL_SOCKET\n"
469 "@defvarx IPPROTO_IP\n"
470 "@defvarx IPPROTO_TCP\n"
471 "@defvarx IPPROTO_UDP\n"
474 "@var{optname} is an integer specifying an option within the\n"
477 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
478 "defined (when provided by the system). For their meaning see\n"
479 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
480 "Manual}, or @command{man 7 socket}.\n"
483 "@defvarx SO_REUSEADDR\n"
484 "@defvarx SO_STYLE\n"
486 "@defvarx SO_ERROR\n"
487 "@defvarx SO_DONTROUTE\n"
488 "@defvarx SO_BROADCAST\n"
489 "@defvarx SO_SNDBUF\n"
490 "@defvarx SO_RCVBUF\n"
491 "@defvarx SO_KEEPALIVE\n"
492 "@defvarx SO_OOBINLINE\n"
493 "@defvarx SO_NO_CHECK\n"
494 "@defvarx SO_PRIORITY\n"
495 "The value returned is an integer.\n"
498 "@defvar SO_LINGER\n"
499 "The @var{value} returned is a pair of integers\n"
500 "@code{(@var{ENABLE} . @var{TIMEOUT})}. On old systems without\n"
501 "timeout support (ie.@: without @code{struct linger}), only\n"
502 "@var{ENABLE} has an effect but the value in Guile is always a\n"
505 #define FUNC_NAME s_scm_getsockopt
508 /* size of optval is the largest supported option. */
509 #ifdef HAVE_STRUCT_LINGER
510 char optval
[sizeof (struct linger
)];
511 socklen_t optlen
= sizeof (struct linger
);
513 char optval
[sizeof (size_t)];
514 socklen_t optlen
= sizeof (size_t);
519 sock
= SCM_COERCE_OUTPORT (sock
);
520 SCM_VALIDATE_OPFPORT (1, sock
);
521 ilevel
= scm_to_int (level
);
522 ioptname
= scm_to_int (optname
);
524 fd
= SCM_FPORT_FDES (sock
);
525 if (getsockopt (fd
, ilevel
, ioptname
, (void *) optval
, &optlen
) == -1)
528 if (ilevel
== SOL_SOCKET
)
531 if (ioptname
== SO_LINGER
)
533 #ifdef HAVE_STRUCT_LINGER
534 struct linger
*ling
= (struct linger
*) optval
;
536 return scm_cons (scm_from_long (ling
->l_onoff
),
537 scm_from_long (ling
->l_linger
));
539 return scm_cons (scm_from_long (*(int *) optval
),
547 || ioptname
== SO_SNDBUF
550 || ioptname
== SO_RCVBUF
554 return scm_from_size_t (*(size_t *) optval
);
557 return scm_from_int (*(int *) optval
);
561 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
562 (SCM sock
, SCM level
, SCM optname
, SCM value
),
563 "Set an option on socket port @var{sock}. The return value is\n"
566 "@var{level} is an integer specifying a protocol layer, either\n"
567 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
568 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
569 "(@pxref{Network Databases}).\n"
571 "@defvar SOL_SOCKET\n"
572 "@defvarx IPPROTO_IP\n"
573 "@defvarx IPPROTO_TCP\n"
574 "@defvarx IPPROTO_UDP\n"
577 "@var{optname} is an integer specifying an option within the\n"
580 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
581 "defined (when provided by the system). For their meaning see\n"
582 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
583 "Manual}, or @command{man 7 socket}.\n"
586 "@defvarx SO_REUSEADDR\n"
587 "@defvarx SO_STYLE\n"
589 "@defvarx SO_ERROR\n"
590 "@defvarx SO_DONTROUTE\n"
591 "@defvarx SO_BROADCAST\n"
592 "@defvarx SO_SNDBUF\n"
593 "@defvarx SO_RCVBUF\n"
594 "@defvarx SO_KEEPALIVE\n"
595 "@defvarx SO_OOBINLINE\n"
596 "@defvarx SO_NO_CHECK\n"
597 "@defvarx SO_PRIORITY\n"
598 "@var{value} is an integer.\n"
601 "@defvar SO_LINGER\n"
602 "@var{value} is a pair of integers @code{(@var{ENABLE}\n"
603 ". @var{TIMEOUT})}. On old systems without timeout support\n"
604 "(ie.@: without @code{struct linger}), only @var{ENABLE} has an\n"
605 "effect but the value in Guile is always a pair.\n"
608 "@c Note that we refer only to ``man ip'' here. On GNU/Linux it's\n"
609 "@c ``man 7 ip'' but on NetBSD it's ``man 4 ip''.\n"
611 "For IP level (@code{IPPROTO_IP}) the following @var{optname}s\n"
612 "are defined (when provided by the system). See @command{man\n"
613 "ip} for what they mean.\n"
615 "@defvar IP_ADD_MEMBERSHIP\n"
616 "@defvarx IP_DROP_MEMBERSHIP\n"
617 "These can be used only with @code{setsockopt}, not\n"
618 "@code{getsockopt}. @var{value} is a pair\n"
619 "@code{(@var{MULTIADDR} . @var{INTERFACEADDR})} of IPv4\n"
620 "addresses (@pxref{Network Address Conversion}).\n"
621 "@var{MULTIADDR} is a multicast address to be added to or\n"
622 "dropped from the interface @var{INTERFACEADDR}.\n"
623 "@var{INTERFACEADDR} can be @code{INADDR_ANY} to have the system\n"
624 "select the interface. @var{INTERFACEADDR} can also be an\n"
625 "interface index number, on systems supporting that.\n"
627 #define FUNC_NAME s_scm_setsockopt
632 #ifdef HAVE_STRUCT_LINGER
633 struct linger opt_linger
;
636 #if HAVE_STRUCT_IP_MREQ
637 struct ip_mreq opt_mreq
;
640 const void *optval
= NULL
;
641 socklen_t optlen
= 0;
643 int ilevel
, ioptname
;
645 sock
= SCM_COERCE_OUTPORT (sock
);
647 SCM_VALIDATE_OPFPORT (1, sock
);
648 ilevel
= scm_to_int (level
);
649 ioptname
= scm_to_int (optname
);
651 fd
= SCM_FPORT_FDES (sock
);
653 if (ilevel
== SOL_SOCKET
)
656 if (ioptname
== SO_LINGER
)
658 #ifdef HAVE_STRUCT_LINGER
659 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
660 opt_linger
.l_onoff
= scm_to_int (SCM_CAR (value
));
661 opt_linger
.l_linger
= scm_to_int (SCM_CDR (value
));
662 optlen
= sizeof (struct linger
);
663 optval
= &opt_linger
;
665 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
666 opt_int
= scm_to_int (SCM_CAR (value
));
667 /* timeout is ignored, but may as well validate it. */
668 scm_to_int (SCM_CDR (value
));
669 optlen
= sizeof (int);
677 || ioptname
== SO_SNDBUF
680 || ioptname
== SO_RCVBUF
684 opt_int
= scm_to_int (value
);
685 optlen
= sizeof (size_t);
690 #if HAVE_STRUCT_IP_MREQ
691 if (ilevel
== IPPROTO_IP
&&
692 (ioptname
== IP_ADD_MEMBERSHIP
|| ioptname
== IP_DROP_MEMBERSHIP
))
694 /* Fourth argument must be a pair of addresses. */
695 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
696 opt_mreq
.imr_multiaddr
.s_addr
= htonl (scm_to_ulong (SCM_CAR (value
)));
697 opt_mreq
.imr_interface
.s_addr
= htonl (scm_to_ulong (SCM_CDR (value
)));
698 optlen
= sizeof (opt_mreq
);
705 /* Most options take an int. */
706 opt_int
= scm_to_int (value
);
707 optlen
= sizeof (int);
711 if (setsockopt (fd
, ilevel
, ioptname
, optval
, optlen
) == -1)
713 return SCM_UNSPECIFIED
;
717 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
719 "Sockets can be closed simply by using @code{close-port}. The\n"
720 "@code{shutdown} procedure allows reception or transmission on a\n"
721 "connection to be shut down individually, according to the parameter\n"
725 "Stop receiving data for this socket. If further data arrives, reject it.\n"
727 "Stop trying to transmit data from this socket. Discard any\n"
728 "data waiting to be sent. Stop looking for acknowledgement of\n"
729 "data already sent; don't retransmit it if it is lost.\n"
731 "Stop both reception and transmission.\n"
733 "The return value is unspecified.")
734 #define FUNC_NAME s_scm_shutdown
737 sock
= SCM_COERCE_OUTPORT (sock
);
738 SCM_VALIDATE_OPFPORT (1, sock
);
739 fd
= SCM_FPORT_FDES (sock
);
740 if (shutdown (fd
, scm_to_signed_integer (how
, 0, 2)) == -1)
742 return SCM_UNSPECIFIED
;
746 /* convert fam/address/args into a sockaddr of the appropriate type.
747 args is modified by removing the arguments actually used.
748 which_arg and proc are used when reporting errors:
749 which_arg is the position of address in the original argument list.
750 proc is the name of the original procedure.
751 size returns the size of the structure allocated. */
753 static struct sockaddr
*
754 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
755 const char *proc
, size_t *size
)
756 #define FUNC_NAME proc
762 struct sockaddr_in
*soka
;
766 SCM_VALIDATE_ULONG_COPY (which_arg
, address
, addr
);
767 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
768 port
= scm_to_int (SCM_CAR (*args
));
769 *args
= SCM_CDR (*args
);
770 soka
= (struct sockaddr_in
*) scm_malloc (sizeof (struct sockaddr_in
));
772 #if HAVE_STRUCT_SOCKADDR_SIN_LEN
773 soka
->sin_len
= sizeof (struct sockaddr_in
);
775 soka
->sin_family
= AF_INET
;
776 soka
->sin_addr
.s_addr
= htonl (addr
);
777 soka
->sin_port
= htons (port
);
778 *size
= sizeof (struct sockaddr_in
);
779 return (struct sockaddr
*) soka
;
786 struct sockaddr_in6
*soka
;
787 unsigned long flowinfo
= 0;
788 unsigned long scope_id
= 0;
790 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
791 port
= scm_to_int (SCM_CAR (*args
));
792 *args
= SCM_CDR (*args
);
793 if (scm_is_pair (*args
))
795 SCM_VALIDATE_ULONG_COPY (which_arg
+ 2, SCM_CAR (*args
), flowinfo
);
796 *args
= SCM_CDR (*args
);
797 if (scm_is_pair (*args
))
799 SCM_VALIDATE_ULONG_COPY (which_arg
+ 3, SCM_CAR (*args
),
801 *args
= SCM_CDR (*args
);
804 soka
= (struct sockaddr_in6
*) scm_malloc (sizeof (struct sockaddr_in6
));
806 #if HAVE_STRUCT_SOCKADDR_IN6_SIN6_LEN
807 soka
->sin6_len
= sizeof (struct sockaddr_in6
);
809 soka
->sin6_family
= AF_INET6
;
810 scm_to_ipv6 (soka
->sin6_addr
.s6_addr
, address
);
811 soka
->sin6_port
= htons (port
);
812 soka
->sin6_flowinfo
= flowinfo
;
813 #ifdef HAVE_SIN6_SCOPE_ID
814 soka
->sin6_scope_id
= scope_id
;
816 *size
= sizeof (struct sockaddr_in6
);
817 return (struct sockaddr
*) soka
;
820 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
823 struct sockaddr_un
*soka
;
827 scm_dynwind_begin (0);
829 c_address
= scm_to_locale_string (address
);
830 scm_dynwind_free (c_address
);
832 /* the static buffer size in sockaddr_un seems to be arbitrary
833 and not necessarily a hard limit. e.g., the glibc manual
834 suggests it may be possible to declare it size 0. let's
835 ignore it. if the O/S doesn't like the size it will cause
836 connect/bind etc., to fail. sun_path is always the last
837 member of the structure. */
838 addr_size
= sizeof (struct sockaddr_un
)
839 + max (0, strlen (c_address
) + 1 - (sizeof soka
->sun_path
));
840 soka
= (struct sockaddr_un
*) scm_malloc (addr_size
);
841 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
842 soka
->sun_family
= AF_UNIX
;
843 strcpy (soka
->sun_path
, c_address
);
844 *size
= SUN_LEN (soka
);
847 return (struct sockaddr
*) soka
;
851 scm_out_of_range (proc
, scm_from_int (fam
));
856 SCM_DEFINE (scm_connect
, "connect", 2, 1, 1,
857 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
858 "Initiate a connection from a socket using a specified address\n"
859 "family to the address\n"
860 "specified by @var{address} and possibly @var{args}.\n"
861 "The format required for @var{address}\n"
862 "and @var{args} depends on the family of the socket.\n\n"
863 "For a socket of family @code{AF_UNIX},\n"
864 "only @var{address} is specified and must be a string with the\n"
865 "filename where the socket is to be created.\n\n"
866 "For a socket of family @code{AF_INET},\n"
867 "@var{address} must be an integer IPv4 host address and\n"
868 "@var{args} must be a single integer port number.\n\n"
869 "For a socket of family @code{AF_INET6},\n"
870 "@var{address} must be an integer IPv6 host address and\n"
871 "@var{args} may be up to three integers:\n"
872 "port [flowinfo] [scope_id],\n"
873 "where flowinfo and scope_id default to zero.\n\n"
874 "Alternatively, the second argument can be a socket address object "
875 "as returned by @code{make-socket-address}, in which case the "
876 "no additional arguments should be passed.\n\n"
877 "The return value is unspecified.")
878 #define FUNC_NAME s_scm_connect
881 struct sockaddr
*soka
;
884 sock
= SCM_COERCE_OUTPORT (sock
);
885 SCM_VALIDATE_OPFPORT (1, sock
);
886 fd
= SCM_FPORT_FDES (sock
);
888 if (address
== SCM_UNDEFINED
)
889 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
890 `socket address' object. */
891 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
893 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
894 &args
, 3, FUNC_NAME
, &size
);
896 if (connect (fd
, soka
, size
) == -1)
898 int save_errno
= errno
;
905 return SCM_UNSPECIFIED
;
909 SCM_DEFINE (scm_bind
, "bind", 2, 1, 1,
910 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
911 "Assign an address to the socket port @var{sock}.\n"
912 "Generally this only needs to be done for server sockets,\n"
913 "so they know where to look for incoming connections. A socket\n"
914 "without an address will be assigned one automatically when it\n"
915 "starts communicating.\n\n"
916 "The format of @var{address} and @var{args} depends\n"
917 "on the family of the socket.\n\n"
918 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
919 "is specified and must be a string with the filename where\n"
920 "the socket is to be created.\n\n"
921 "For a socket of family @code{AF_INET}, @var{address}\n"
922 "must be an integer IPv4 address and @var{args}\n"
923 "must be a single integer port number.\n\n"
924 "The values of the following variables can also be used for\n"
926 "@defvar INADDR_ANY\n"
927 "Allow connections from any address.\n"
929 "@defvar INADDR_LOOPBACK\n"
930 "The address of the local host using the loopback device.\n"
932 "@defvar INADDR_BROADCAST\n"
933 "The broadcast address on the local network.\n"
935 "@defvar INADDR_NONE\n"
938 "For a socket of family @code{AF_INET6}, @var{address}\n"
939 "must be an integer IPv6 address and @var{args}\n"
940 "may be up to three integers:\n"
941 "port [flowinfo] [scope_id],\n"
942 "where flowinfo and scope_id default to zero.\n\n"
943 "Alternatively, the second argument can be a socket address object "
944 "as returned by @code{make-socket-address}, in which case the "
945 "no additional arguments should be passed.\n\n"
946 "The return value is unspecified.")
947 #define FUNC_NAME s_scm_bind
949 struct sockaddr
*soka
;
953 sock
= SCM_COERCE_OUTPORT (sock
);
954 SCM_VALIDATE_OPFPORT (1, sock
);
955 fd
= SCM_FPORT_FDES (sock
);
957 if (address
== SCM_UNDEFINED
)
958 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
959 `socket address' object. */
960 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
962 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
963 &args
, 3, FUNC_NAME
, &size
);
966 if (bind (fd
, soka
, size
) == -1)
968 int save_errno
= errno
;
975 return SCM_UNSPECIFIED
;
979 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
980 (SCM sock
, SCM backlog
),
981 "Enable @var{sock} to accept connection\n"
982 "requests. @var{backlog} is an integer specifying\n"
983 "the maximum length of the queue for pending connections.\n"
984 "If the queue fills, new clients will fail to connect until\n"
985 "the server calls @code{accept} to accept a connection from\n"
987 "The return value is unspecified.")
988 #define FUNC_NAME s_scm_listen
991 sock
= SCM_COERCE_OUTPORT (sock
);
992 SCM_VALIDATE_OPFPORT (1, sock
);
993 fd
= SCM_FPORT_FDES (sock
);
994 if (listen (fd
, scm_to_int (backlog
)) == -1)
996 return SCM_UNSPECIFIED
;
1000 /* Put the components of a sockaddr into a new SCM vector. */
1001 static SCM_C_INLINE_KEYWORD SCM
1002 _scm_from_sockaddr (const struct sockaddr
*address
, unsigned addr_size
,
1005 short int fam
= address
->sa_family
;
1006 SCM result
=SCM_EOL
;
1013 const struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
1015 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
1017 SCM_SIMPLE_VECTOR_SET(result
, 0,
1018 scm_from_short (fam
));
1019 SCM_SIMPLE_VECTOR_SET(result
, 1,
1020 scm_from_ulong (ntohl (nad
->sin_addr
.s_addr
)));
1021 SCM_SIMPLE_VECTOR_SET(result
, 2,
1022 scm_from_ushort (ntohs (nad
->sin_port
)));
1028 const struct sockaddr_in6
*nad
= (struct sockaddr_in6
*) address
;
1030 result
= scm_c_make_vector (5, SCM_UNSPECIFIED
);
1031 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1032 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_ipv6 (nad
->sin6_addr
.s6_addr
));
1033 SCM_SIMPLE_VECTOR_SET(result
, 2, scm_from_ushort (ntohs (nad
->sin6_port
)));
1034 SCM_SIMPLE_VECTOR_SET(result
, 3, scm_from_uint32 (nad
->sin6_flowinfo
));
1035 #ifdef HAVE_SIN6_SCOPE_ID
1036 SCM_SIMPLE_VECTOR_SET(result
, 4, scm_from_ulong (nad
->sin6_scope_id
));
1038 SCM_SIMPLE_VECTOR_SET(result
, 4, SCM_INUM0
);
1043 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1046 const struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
1048 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
1050 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1051 /* When addr_size is not enough to cover sun_path, do not try
1053 if (addr_size
<= offsetof (struct sockaddr_un
, sun_path
))
1054 SCM_SIMPLE_VECTOR_SET(result
, 1, SCM_BOOL_F
);
1056 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_locale_string (nad
->sun_path
));
1061 result
= SCM_UNSPECIFIED
;
1062 scm_misc_error (proc
, "unrecognised address family: ~A",
1063 scm_list_1 (scm_from_int (fam
)));
1069 /* The publicly-visible function. Return a Scheme object representing
1070 ADDRESS, an address of ADDR_SIZE bytes. */
1072 scm_from_sockaddr (const struct sockaddr
*address
, unsigned addr_size
)
1074 return (_scm_from_sockaddr (address
, addr_size
, "scm_from_sockaddr"));
1077 /* Convert ADDRESS, an address object returned by either
1078 `scm_from_sockaddr ()' or `scm_make_socket_address ()', into its C
1079 representation. On success, a non-NULL pointer is returned and
1080 ADDRESS_SIZE is updated to the actual size (in bytes) of the returned
1081 address. The result must eventually be freed using `free ()'. */
1083 scm_to_sockaddr (SCM address
, size_t *address_size
)
1084 #define FUNC_NAME "scm_to_sockaddr"
1087 struct sockaddr
*c_address
= NULL
;
1089 SCM_VALIDATE_VECTOR (1, address
);
1092 family
= scm_to_short (SCM_SIMPLE_VECTOR_REF (address
, 0));
1098 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 3)
1099 scm_misc_error (FUNC_NAME
,
1100 "invalid inet address representation: ~A",
1101 scm_list_1 (address
));
1104 struct sockaddr_in c_inet
;
1106 c_inet
.sin_addr
.s_addr
=
1107 htonl (scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 1)));
1109 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1110 c_inet
.sin_family
= AF_INET
;
1112 *address_size
= sizeof (c_inet
);
1113 c_address
= scm_malloc (sizeof (c_inet
));
1114 memcpy (c_address
, &c_inet
, sizeof (c_inet
));
1123 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 5)
1124 scm_misc_error (FUNC_NAME
, "invalid inet6 address representation: ~A",
1125 scm_list_1 (address
));
1128 struct sockaddr_in6 c_inet6
;
1130 scm_to_ipv6 (c_inet6
.sin6_addr
.s6_addr
, address
);
1132 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1133 c_inet6
.sin6_flowinfo
=
1134 scm_to_uint32 (SCM_SIMPLE_VECTOR_REF (address
, 3));
1135 #ifdef HAVE_SIN6_SCOPE_ID
1136 c_inet6
.sin6_scope_id
=
1137 scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 4));
1140 c_inet6
.sin6_family
= AF_INET6
;
1142 *address_size
= sizeof (c_inet6
);
1143 c_address
= scm_malloc (sizeof (c_inet6
));
1144 memcpy (c_address
, &c_inet6
, sizeof (c_inet6
));
1151 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1154 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 2)
1155 scm_misc_error (FUNC_NAME
, "invalid unix address representation: ~A",
1156 scm_list_1 (address
));
1160 size_t path_len
= 0;
1162 path
= SCM_SIMPLE_VECTOR_REF (address
, 1);
1163 if ((!scm_is_string (path
)) && (path
!= SCM_BOOL_F
))
1164 scm_misc_error (FUNC_NAME
, "invalid unix address "
1165 "path: ~A", scm_list_1 (path
));
1168 struct sockaddr_un c_unix
;
1170 if (path
== SCM_BOOL_F
)
1173 path_len
= scm_c_string_length (path
);
1175 #ifdef UNIX_PATH_MAX
1176 if (path_len
>= UNIX_PATH_MAX
)
1178 /* We can hope that this limit will eventually vanish, at least on GNU.
1179 However, currently, while glibc doesn't define `UNIX_PATH_MAX', it
1180 documents it has being limited to 108 bytes. */
1181 if (path_len
>= sizeof (c_unix
.sun_path
))
1183 scm_misc_error (FUNC_NAME
, "unix address path "
1184 "too long: ~A", scm_list_1 (path
));
1189 scm_to_locale_stringbuf (path
, c_unix
.sun_path
,
1190 #ifdef UNIX_PATH_MAX
1193 sizeof (c_unix
.sun_path
));
1195 c_unix
.sun_path
[path_len
] = '\0';
1198 if (strlen (c_unix
.sun_path
) != path_len
)
1199 scm_misc_error (FUNC_NAME
, "unix address path "
1200 "contains nul characters: ~A",
1204 c_unix
.sun_path
[0] = '\0';
1206 c_unix
.sun_family
= AF_UNIX
;
1208 *address_size
= SUN_LEN (&c_unix
);
1209 c_address
= scm_malloc (sizeof (c_unix
));
1210 memcpy (c_address
, &c_unix
, sizeof (c_unix
));
1220 scm_misc_error (FUNC_NAME
, "unrecognised address family: ~A",
1221 scm_list_1 (scm_from_ushort (family
)));
1229 /* Return a newly-allocated `sockaddr' structure that reflects ADDRESS, being
1230 an address of family FAMILY, with the family-specific parameters ARGS (see
1231 the description of `connect' for details). The returned structure may be
1232 freed using `free ()'. */
1234 scm_c_make_socket_address (SCM family
, SCM address
, SCM args
,
1235 size_t *address_size
)
1237 struct sockaddr
*soka
;
1239 soka
= scm_fill_sockaddr (scm_to_ushort (family
), address
, &args
, 1,
1240 "scm_c_make_socket_address", address_size
);
1245 SCM_DEFINE (scm_make_socket_address
, "make-socket-address", 2, 0, 1,
1246 (SCM family
, SCM address
, SCM args
),
1247 "Return a Scheme address object that reflects @var{address}, "
1248 "being an address of family @var{family}, with the "
1249 "family-specific parameters @var{args} (see the description of "
1250 "@code{connect} for details).")
1251 #define FUNC_NAME s_scm_make_socket_address
1253 struct sockaddr
*c_address
;
1254 size_t c_address_size
;
1256 c_address
= scm_c_make_socket_address (family
, address
, args
,
1261 return (scm_from_sockaddr (c_address
, c_address_size
));
1266 /* calculate the size of a buffer large enough to hold any supported
1267 sockaddr type. if the buffer isn't large enough, certain system
1268 calls will return a truncated address. */
1270 #if defined (HAVE_UNIX_DOMAIN_SOCKETS)
1271 #define MAX_SIZE_UN sizeof (struct sockaddr_un)
1273 #define MAX_SIZE_UN 0
1276 #if defined (HAVE_IPV6)
1277 #define MAX_SIZE_IN6 sizeof (struct sockaddr_in6)
1279 #define MAX_SIZE_IN6 0
1282 #define MAX_ADDR_SIZE max (max (sizeof (struct sockaddr_in), MAX_SIZE_IN6),\
1285 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
1287 "Accept a connection on a bound, listening socket.\n"
1289 "are no pending connections in the queue, wait until\n"
1290 "one is available unless the non-blocking option has been\n"
1291 "set on the socket.\n\n"
1292 "The return value is a\n"
1293 "pair in which the @emph{car} is a new socket port for the\n"
1295 "the @emph{cdr} is an object with address information about the\n"
1296 "client which initiated the connection.\n\n"
1297 "@var{sock} does not become part of the\n"
1298 "connection and will continue to accept new requests.")
1299 #define FUNC_NAME s_scm_accept
1305 socklen_t addr_size
= MAX_ADDR_SIZE
;
1306 char max_addr
[MAX_ADDR_SIZE
];
1307 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1309 sock
= SCM_COERCE_OUTPORT (sock
);
1310 SCM_VALIDATE_OPFPORT (1, sock
);
1311 fd
= SCM_FPORT_FDES (sock
);
1312 newfd
= accept (fd
, addr
, &addr_size
);
1315 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
1316 address
= _scm_from_sockaddr (addr
, addr_size
, FUNC_NAME
);
1317 return scm_cons (newsock
, address
);
1321 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
1323 "Return the address of @var{sock}, in the same form as the\n"
1324 "object returned by @code{accept}. On many systems the address\n"
1325 "of a socket in the @code{AF_FILE} namespace cannot be read.")
1326 #define FUNC_NAME s_scm_getsockname
1329 socklen_t addr_size
= MAX_ADDR_SIZE
;
1330 char max_addr
[MAX_ADDR_SIZE
];
1331 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1333 sock
= SCM_COERCE_OUTPORT (sock
);
1334 SCM_VALIDATE_OPFPORT (1, sock
);
1335 fd
= SCM_FPORT_FDES (sock
);
1336 if (getsockname (fd
, addr
, &addr_size
) == -1)
1338 return _scm_from_sockaddr (addr
, addr_size
, FUNC_NAME
);
1342 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
1344 "Return the address that @var{sock}\n"
1345 "is connected to, in the same form as the object returned by\n"
1346 "@code{accept}. On many systems the address of a socket in the\n"
1347 "@code{AF_FILE} namespace cannot be read.")
1348 #define FUNC_NAME s_scm_getpeername
1351 socklen_t addr_size
= MAX_ADDR_SIZE
;
1352 char max_addr
[MAX_ADDR_SIZE
];
1353 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1355 sock
= SCM_COERCE_OUTPORT (sock
);
1356 SCM_VALIDATE_OPFPORT (1, sock
);
1357 fd
= SCM_FPORT_FDES (sock
);
1358 if (getpeername (fd
, addr
, &addr_size
) == -1)
1360 return _scm_from_sockaddr (addr
, addr_size
, FUNC_NAME
);
1364 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
1365 (SCM sock
, SCM buf
, SCM flags
),
1366 "Receive data from a socket port.\n"
1367 "@var{sock} must already\n"
1368 "be bound to the address from which data is to be received.\n"
1369 "@var{buf} is a string into which\n"
1370 "the data will be written. The size of @var{buf} limits\n"
1372 "data which can be received: in the case of packet\n"
1373 "protocols, if a packet larger than this limit is encountered\n"
1375 "will be irrevocably lost.\n\n"
1376 "The optional @var{flags} argument is a value or\n"
1377 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1378 "The value returned is the number of bytes read from the\n"
1380 "Note that the data is read directly from the socket file\n"
1382 "any unread buffered port data is ignored.")
1383 #define FUNC_NAME s_scm_recv
1391 SCM_VALIDATE_OPFPORT (1, sock
);
1392 SCM_VALIDATE_STRING (2, buf
);
1393 if (SCM_UNBNDP (flags
))
1396 flg
= scm_to_int (flags
);
1397 fd
= SCM_FPORT_FDES (sock
);
1399 len
= scm_i_string_length (buf
);
1400 dest
= scm_i_string_writable_chars (buf
);
1401 SCM_SYSCALL (rv
= recv (fd
, dest
, len
, flg
));
1402 scm_i_string_stop_writing ();
1407 scm_remember_upto_here_1 (buf
);
1408 return scm_from_int (rv
);
1412 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
1413 (SCM sock
, SCM message
, SCM flags
),
1414 "Transmit the string @var{message} on a socket port @var{sock}.\n"
1415 "@var{sock} must already be bound to a destination address. The\n"
1416 "value returned is the number of bytes transmitted --\n"
1417 "it's possible for\n"
1418 "this to be less than the length of @var{message}\n"
1419 "if the socket is\n"
1420 "set to be non-blocking. The optional @var{flags} argument\n"
1422 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1423 "Note that the data is written directly to the socket\n"
1424 "file descriptor:\n"
1425 "any unflushed buffered port data is ignored.")
1426 #define FUNC_NAME s_scm_send
1434 sock
= SCM_COERCE_OUTPORT (sock
);
1435 SCM_VALIDATE_OPFPORT (1, sock
);
1436 SCM_VALIDATE_STRING (2, message
);
1437 if (SCM_UNBNDP (flags
))
1440 flg
= scm_to_int (flags
);
1441 fd
= SCM_FPORT_FDES (sock
);
1443 len
= scm_i_string_length (message
);
1444 src
= scm_i_string_writable_chars (message
);
1445 SCM_SYSCALL (rv
= send (fd
, src
, len
, flg
));
1446 scm_i_string_stop_writing ();
1451 scm_remember_upto_here_1 (message
);
1452 return scm_from_int (rv
);
1456 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
1457 (SCM sock
, SCM str
, SCM flags
, SCM start
, SCM end
),
1458 "Receive data from socket port @var{sock} (which must be already\n"
1459 "bound), returning the originating address as well as the data.\n"
1460 "This is usually for use on datagram sockets, but can be used on\n"
1461 "stream-oriented sockets too.\n"
1463 "The data received is stored in the given @var{str}, using\n"
1464 "either the whole string or just the region between the optional\n"
1465 "@var{start} and @var{end} positions. The size of @var{str}\n"
1466 "limits the amount of data which can be received. For datagram\n"
1467 "protocols, if a packet larger than this is received then excess\n"
1468 "bytes are irrevocably lost.\n"
1470 "The return value is a pair. The @code{car} is the number of\n"
1471 "bytes read. The @code{cdr} is a socket address object which is\n"
1472 "where the data come from, or @code{#f} if the origin is\n"
1475 "The optional @var{flags} argument is a or bitwise OR\n"
1476 "(@code{logior}) of @code{MSG_OOB}, @code{MSG_PEEK},\n"
1477 "@code{MSG_DONTROUTE} etc.\n"
1479 "Data is read directly from the socket file descriptor, any\n"
1480 "buffered port data is ignored.\n"
1482 "On a GNU/Linux system @code{recvfrom!} is not multi-threading,\n"
1483 "all threads stop while a @code{recvfrom!} call is in progress.\n"
1484 "An application may need to use @code{select}, @code{O_NONBLOCK}\n"
1485 "or @code{MSG_DONTWAIT} to avoid this.")
1486 #define FUNC_NAME s_scm_recvfrom
1495 socklen_t addr_size
= MAX_ADDR_SIZE
;
1496 char max_addr
[MAX_ADDR_SIZE
];
1497 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1499 SCM_VALIDATE_OPFPORT (1, sock
);
1500 fd
= SCM_FPORT_FDES (sock
);
1502 SCM_VALIDATE_STRING (2, str
);
1503 scm_i_get_substring_spec (scm_i_string_length (str
),
1504 start
, &offset
, end
, &cend
);
1506 if (SCM_UNBNDP (flags
))
1509 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
1511 /* recvfrom will not necessarily return an address. usually nothing
1512 is returned for stream sockets. */
1513 buf
= scm_i_string_writable_chars (str
);
1514 addr
->sa_family
= AF_UNSPEC
;
1515 SCM_SYSCALL (rv
= recvfrom (fd
, buf
+ offset
,
1518 scm_i_string_stop_writing ();
1522 if (addr
->sa_family
!= AF_UNSPEC
)
1523 address
= _scm_from_sockaddr (addr
, addr_size
, FUNC_NAME
);
1525 address
= SCM_BOOL_F
;
1527 scm_remember_upto_here_1 (str
);
1528 return scm_cons (scm_from_int (rv
), address
);
1532 SCM_DEFINE (scm_sendto
, "sendto", 3, 1, 1,
1533 (SCM sock
, SCM message
, SCM fam_or_sockaddr
, SCM address
, SCM args_and_flags
),
1534 "Transmit the string @var{message} on the socket port\n"
1536 "destination address is specified using the @var{fam},\n"
1537 "@var{address} and\n"
1538 "@var{args_and_flags} arguments, or just a socket address object "
1539 "returned by @code{make-socket-address}, in a similar way to the\n"
1540 "@code{connect} procedure. @var{args_and_flags} contains\n"
1541 "the usual connection arguments optionally followed by\n"
1542 "a flags argument, which is a value or\n"
1543 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1544 "The value returned is the number of bytes transmitted --\n"
1545 "it's possible for\n"
1546 "this to be less than the length of @var{message} if the\n"
1548 "set to be non-blocking.\n"
1549 "Note that the data is written directly to the socket\n"
1550 "file descriptor:\n"
1551 "any unflushed buffered port data is ignored.")
1552 #define FUNC_NAME s_scm_sendto
1557 struct sockaddr
*soka
;
1560 sock
= SCM_COERCE_OUTPORT (sock
);
1561 SCM_VALIDATE_FPORT (1, sock
);
1562 SCM_VALIDATE_STRING (2, message
);
1563 fd
= SCM_FPORT_FDES (sock
);
1565 if (!scm_is_number (fam_or_sockaddr
))
1567 /* FAM_OR_SOCKADDR must actually be a `socket address' object. This
1568 means that the following arguments, i.e. ADDRESS and those listed in
1569 ARGS_AND_FLAGS, are the `MSG_' flags. */
1570 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
1571 if (address
!= SCM_UNDEFINED
)
1572 args_and_flags
= scm_cons (address
, args_and_flags
);
1575 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
1576 &args_and_flags
, 3, FUNC_NAME
, &size
);
1578 if (scm_is_null (args_and_flags
))
1582 SCM_VALIDATE_CONS (5, args_and_flags
);
1583 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
1585 SCM_SYSCALL (rv
= sendto (fd
,
1586 scm_i_string_chars (message
),
1587 scm_i_string_length (message
),
1591 int save_errno
= errno
;
1598 scm_remember_upto_here_1 (message
);
1599 return scm_from_int (rv
);
1608 /* protocol families. */
1610 scm_c_define ("AF_UNSPEC", scm_from_int (AF_UNSPEC
));
1613 scm_c_define ("AF_UNIX", scm_from_int (AF_UNIX
));
1616 scm_c_define ("AF_INET", scm_from_int (AF_INET
));
1619 scm_c_define ("AF_INET6", scm_from_int (AF_INET6
));
1623 scm_c_define ("PF_UNSPEC", scm_from_int (PF_UNSPEC
));
1626 scm_c_define ("PF_UNIX", scm_from_int (PF_UNIX
));
1629 scm_c_define ("PF_INET", scm_from_int (PF_INET
));
1632 scm_c_define ("PF_INET6", scm_from_int (PF_INET6
));
1635 /* standard addresses. */
1637 scm_c_define ("INADDR_ANY", scm_from_ulong (INADDR_ANY
));
1639 #ifdef INADDR_BROADCAST
1640 scm_c_define ("INADDR_BROADCAST", scm_from_ulong (INADDR_BROADCAST
));
1643 scm_c_define ("INADDR_NONE", scm_from_ulong (INADDR_NONE
));
1645 #ifdef INADDR_LOOPBACK
1646 scm_c_define ("INADDR_LOOPBACK", scm_from_ulong (INADDR_LOOPBACK
));
1651 SOCK_PACKET is deliberately omitted, the GNU/Linux socket(2) and
1652 packet(7) advise that it's obsolete and strongly deprecated. */
1655 scm_c_define ("SOCK_STREAM", scm_from_int (SOCK_STREAM
));
1658 scm_c_define ("SOCK_DGRAM", scm_from_int (SOCK_DGRAM
));
1660 #ifdef SOCK_SEQPACKET
1661 scm_c_define ("SOCK_SEQPACKET", scm_from_int (SOCK_SEQPACKET
));
1664 scm_c_define ("SOCK_RAW", scm_from_int (SOCK_RAW
));
1667 scm_c_define ("SOCK_RDM", scm_from_int (SOCK_RDM
));
1670 /* setsockopt level.
1672 SOL_IP, SOL_TCP and SOL_UDP are defined on gnu/linux, but not on for
1673 instance NetBSD. We define IPPROTOs because that's what the posix spec
1674 shows in its example at
1676 http://www.opengroup.org/onlinepubs/007904975/functions/getsockopt.html
1679 scm_c_define ("SOL_SOCKET", scm_from_int (SOL_SOCKET
));
1682 scm_c_define ("IPPROTO_IP", scm_from_int (IPPROTO_IP
));
1685 scm_c_define ("IPPROTO_TCP", scm_from_int (IPPROTO_TCP
));
1688 scm_c_define ("IPPROTO_UDP", scm_from_int (IPPROTO_UDP
));
1691 /* setsockopt names. */
1693 scm_c_define ("SO_DEBUG", scm_from_int (SO_DEBUG
));
1696 scm_c_define ("SO_REUSEADDR", scm_from_int (SO_REUSEADDR
));
1699 scm_c_define ("SO_STYLE", scm_from_int (SO_STYLE
));
1702 scm_c_define ("SO_TYPE", scm_from_int (SO_TYPE
));
1705 scm_c_define ("SO_ERROR", scm_from_int (SO_ERROR
));
1708 scm_c_define ("SO_DONTROUTE", scm_from_int (SO_DONTROUTE
));
1711 scm_c_define ("SO_BROADCAST", scm_from_int (SO_BROADCAST
));
1714 scm_c_define ("SO_SNDBUF", scm_from_int (SO_SNDBUF
));
1717 scm_c_define ("SO_RCVBUF", scm_from_int (SO_RCVBUF
));
1720 scm_c_define ("SO_KEEPALIVE", scm_from_int (SO_KEEPALIVE
));
1723 scm_c_define ("SO_OOBINLINE", scm_from_int (SO_OOBINLINE
));
1726 scm_c_define ("SO_NO_CHECK", scm_from_int (SO_NO_CHECK
));
1729 scm_c_define ("SO_PRIORITY", scm_from_int (SO_PRIORITY
));
1732 scm_c_define ("SO_LINGER", scm_from_int (SO_LINGER
));
1735 /* recv/send options. */
1737 scm_c_define ("MSG_DONTWAIT", scm_from_int (MSG_DONTWAIT
));
1740 scm_c_define ("MSG_OOB", scm_from_int (MSG_OOB
));
1743 scm_c_define ("MSG_PEEK", scm_from_int (MSG_PEEK
));
1745 #ifdef MSG_DONTROUTE
1746 scm_c_define ("MSG_DONTROUTE", scm_from_int (MSG_DONTROUTE
));
1750 scm_i_init_socket_Win32 ();
1753 #ifdef IP_ADD_MEMBERSHIP
1754 scm_c_define ("IP_ADD_MEMBERSHIP", scm_from_int (IP_ADD_MEMBERSHIP
));
1755 scm_c_define ("IP_DROP_MEMBERSHIP", scm_from_int (IP_DROP_MEMBERSHIP
));
1758 scm_add_feature ("socket");
1760 #include "libguile/socket.x"