1 /* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007 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
);
397 addr4
= htonl (SCM_NUM2ULONG (2, address
));
398 result
= inet_ntop (af
, &addr4
, dst
, sizeof (dst
));
404 scm_to_ipv6 ((scm_t_uint8
*) addr6
, address
);
405 result
= inet_ntop (af
, &addr6
, dst
, sizeof (dst
));
411 return scm_from_locale_string (dst
);
416 #endif /* HAVE_IPV6 */
418 SCM_SYMBOL (sym_socket
, "socket");
420 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
422 SCM_DEFINE (scm_socket
, "socket", 3, 0, 0,
423 (SCM family
, SCM style
, SCM proto
),
424 "Return a new socket port of the type specified by @var{family},\n"
425 "@var{style} and @var{proto}. All three parameters are\n"
426 "integers. Supported values for @var{family} are\n"
427 "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
428 "Typical values for @var{style} are @code{SOCK_STREAM},\n"
429 "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
430 "@var{proto} can be obtained from a protocol name using\n"
431 "@code{getprotobyname}. A value of zero specifies the default\n"
432 "protocol, which is usually right.\n\n"
433 "A single socket port cannot by used for communication until it\n"
434 "has been connected to another socket.")
435 #define FUNC_NAME s_scm_socket
439 fd
= socket (scm_to_int (family
),
444 return SCM_SOCK_FD_TO_PORT (fd
);
448 #ifdef HAVE_SOCKETPAIR
449 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
450 (SCM family
, SCM style
, SCM proto
),
451 "Return a pair of connected (but unnamed) socket ports of the\n"
452 "type specified by @var{family}, @var{style} and @var{proto}.\n"
453 "Many systems support only socket pairs of the @code{AF_UNIX}\n"
454 "family. Zero is likely to be the only meaningful value for\n"
456 #define FUNC_NAME s_scm_socketpair
461 fam
= scm_to_int (family
);
463 if (socketpair (fam
, scm_to_int (style
), scm_to_int (proto
), fd
) == -1)
466 return scm_cons (SCM_SOCK_FD_TO_PORT (fd
[0]), SCM_SOCK_FD_TO_PORT (fd
[1]));
471 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
472 (SCM sock
, SCM level
, SCM optname
),
473 "Return an option value from socket port @var{sock}.\n"
475 "@var{level} is an integer specifying a protocol layer, either\n"
476 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
477 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
478 "(@pxref{Network Databases}).\n"
480 "@defvar SOL_SOCKET\n"
481 "@defvarx IPPROTO_IP\n"
482 "@defvarx IPPROTO_TCP\n"
483 "@defvarx IPPROTO_UDP\n"
486 "@var{optname} is an integer specifying an option within the\n"
489 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
490 "defined (when provided by the system). For their meaning see\n"
491 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
492 "Manual}, or @command{man 7 socket}.\n"
495 "@defvarx SO_REUSEADDR\n"
496 "@defvarx SO_STYLE\n"
498 "@defvarx SO_ERROR\n"
499 "@defvarx SO_DONTROUTE\n"
500 "@defvarx SO_BROADCAST\n"
501 "@defvarx SO_SNDBUF\n"
502 "@defvarx SO_RCVBUF\n"
503 "@defvarx SO_KEEPALIVE\n"
504 "@defvarx SO_OOBINLINE\n"
505 "@defvarx SO_NO_CHECK\n"
506 "@defvarx SO_PRIORITY\n"
507 "The value returned is an integer.\n"
510 "@defvar SO_LINGER\n"
511 "The @var{value} returned is a pair of integers\n"
512 "@code{(@var{ENABLE} . @var{TIMEOUT})}. On old systems without\n"
513 "timeout support (ie.@: without @code{struct linger}), only\n"
514 "@var{ENABLE} has an effect but the value in Guile is always a\n"
517 #define FUNC_NAME s_scm_getsockopt
520 /* size of optval is the largest supported option. */
521 #ifdef HAVE_STRUCT_LINGER
522 char optval
[sizeof (struct linger
)];
523 socklen_t optlen
= sizeof (struct linger
);
525 char optval
[sizeof (size_t)];
526 socklen_t optlen
= sizeof (size_t);
531 sock
= SCM_COERCE_OUTPORT (sock
);
532 SCM_VALIDATE_OPFPORT (1, sock
);
533 ilevel
= scm_to_int (level
);
534 ioptname
= scm_to_int (optname
);
536 fd
= SCM_FPORT_FDES (sock
);
537 if (getsockopt (fd
, ilevel
, ioptname
, (void *) optval
, &optlen
) == -1)
540 if (ilevel
== SOL_SOCKET
)
543 if (ioptname
== SO_LINGER
)
545 #ifdef HAVE_STRUCT_LINGER
546 struct linger
*ling
= (struct linger
*) optval
;
548 return scm_cons (scm_from_long (ling
->l_onoff
),
549 scm_from_long (ling
->l_linger
));
551 return scm_cons (scm_from_long (*(int *) optval
),
559 || ioptname
== SO_SNDBUF
562 || ioptname
== SO_RCVBUF
566 return scm_from_size_t (*(size_t *) optval
);
569 return scm_from_int (*(int *) optval
);
573 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
574 (SCM sock
, SCM level
, SCM optname
, SCM value
),
575 "Set an option on socket port @var{sock}. The return value is\n"
578 "@var{level} is an integer specifying a protocol layer, either\n"
579 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
580 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
581 "(@pxref{Network Databases}).\n"
583 "@defvar SOL_SOCKET\n"
584 "@defvarx IPPROTO_IP\n"
585 "@defvarx IPPROTO_TCP\n"
586 "@defvarx IPPROTO_UDP\n"
589 "@var{optname} is an integer specifying an option within the\n"
592 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
593 "defined (when provided by the system). For their meaning see\n"
594 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
595 "Manual}, or @command{man 7 socket}.\n"
598 "@defvarx SO_REUSEADDR\n"
599 "@defvarx SO_STYLE\n"
601 "@defvarx SO_ERROR\n"
602 "@defvarx SO_DONTROUTE\n"
603 "@defvarx SO_BROADCAST\n"
604 "@defvarx SO_SNDBUF\n"
605 "@defvarx SO_RCVBUF\n"
606 "@defvarx SO_KEEPALIVE\n"
607 "@defvarx SO_OOBINLINE\n"
608 "@defvarx SO_NO_CHECK\n"
609 "@defvarx SO_PRIORITY\n"
610 "@var{value} is an integer.\n"
613 "@defvar SO_LINGER\n"
614 "@var{value} is a pair of integers @code{(@var{ENABLE}\n"
615 ". @var{TIMEOUT})}. On old systems without timeout support\n"
616 "(ie.@: without @code{struct linger}), only @var{ENABLE} has an\n"
617 "effect but the value in Guile is always a pair.\n"
620 "@c Note that we refer only to ``man ip'' here. On GNU/Linux it's\n"
621 "@c ``man 7 ip'' but on NetBSD it's ``man 4 ip''.\n"
623 "For IP level (@code{IPPROTO_IP}) the following @var{optname}s\n"
624 "are defined (when provided by the system). See @command{man\n"
625 "ip} for what they mean.\n"
627 "@defvar IP_ADD_MEMBERSHIP\n"
628 "@defvarx IP_DROP_MEMBERSHIP\n"
629 "These can be used only with @code{setsockopt}, not\n"
630 "@code{getsockopt}. @var{value} is a pair\n"
631 "@code{(@var{MULTIADDR} . @var{INTERFACEADDR})} of IPv4\n"
632 "addresses (@pxref{Network Address Conversion}).\n"
633 "@var{MULTIADDR} is a multicast address to be added to or\n"
634 "dropped from the interface @var{INTERFACEADDR}.\n"
635 "@var{INTERFACEADDR} can be @code{INADDR_ANY} to have the system\n"
636 "select the interface. @var{INTERFACEADDR} can also be an\n"
637 "interface index number, on systems supporting that.\n"
639 #define FUNC_NAME s_scm_setsockopt
644 #ifdef HAVE_STRUCT_LINGER
645 struct linger opt_linger
;
648 #if HAVE_STRUCT_IP_MREQ
649 struct ip_mreq opt_mreq
;
652 const void *optval
= NULL
;
653 socklen_t optlen
= 0;
655 int ilevel
, ioptname
;
657 sock
= SCM_COERCE_OUTPORT (sock
);
659 SCM_VALIDATE_OPFPORT (1, sock
);
660 ilevel
= scm_to_int (level
);
661 ioptname
= scm_to_int (optname
);
663 fd
= SCM_FPORT_FDES (sock
);
665 if (ilevel
== SOL_SOCKET
)
668 if (ioptname
== SO_LINGER
)
670 #ifdef HAVE_STRUCT_LINGER
671 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
672 opt_linger
.l_onoff
= scm_to_int (SCM_CAR (value
));
673 opt_linger
.l_linger
= scm_to_int (SCM_CDR (value
));
674 optlen
= sizeof (struct linger
);
675 optval
= &opt_linger
;
677 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
678 opt_int
= scm_to_int (SCM_CAR (value
));
679 /* timeout is ignored, but may as well validate it. */
680 scm_to_int (SCM_CDR (value
));
681 optlen
= sizeof (int);
689 || ioptname
== SO_SNDBUF
692 || ioptname
== SO_RCVBUF
696 opt_int
= scm_to_int (value
);
697 optlen
= sizeof (size_t);
702 #if HAVE_STRUCT_IP_MREQ
703 if (ilevel
== IPPROTO_IP
&&
704 (ioptname
== IP_ADD_MEMBERSHIP
|| ioptname
== IP_DROP_MEMBERSHIP
))
706 /* Fourth argument must be a pair of addresses. */
707 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
708 opt_mreq
.imr_multiaddr
.s_addr
= htonl (scm_to_ulong (SCM_CAR (value
)));
709 opt_mreq
.imr_interface
.s_addr
= htonl (scm_to_ulong (SCM_CDR (value
)));
710 optlen
= sizeof (opt_mreq
);
717 /* Most options take an int. */
718 opt_int
= scm_to_int (value
);
719 optlen
= sizeof (int);
723 if (setsockopt (fd
, ilevel
, ioptname
, optval
, optlen
) == -1)
725 return SCM_UNSPECIFIED
;
729 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
731 "Sockets can be closed simply by using @code{close-port}. The\n"
732 "@code{shutdown} procedure allows reception or transmission on a\n"
733 "connection to be shut down individually, according to the parameter\n"
737 "Stop receiving data for this socket. If further data arrives, reject it.\n"
739 "Stop trying to transmit data from this socket. Discard any\n"
740 "data waiting to be sent. Stop looking for acknowledgement of\n"
741 "data already sent; don't retransmit it if it is lost.\n"
743 "Stop both reception and transmission.\n"
745 "The return value is unspecified.")
746 #define FUNC_NAME s_scm_shutdown
749 sock
= SCM_COERCE_OUTPORT (sock
);
750 SCM_VALIDATE_OPFPORT (1, sock
);
751 fd
= SCM_FPORT_FDES (sock
);
752 if (shutdown (fd
, scm_to_signed_integer (how
, 0, 2)) == -1)
754 return SCM_UNSPECIFIED
;
758 /* convert fam/address/args into a sockaddr of the appropriate type.
759 args is modified by removing the arguments actually used.
760 which_arg and proc are used when reporting errors:
761 which_arg is the position of address in the original argument list.
762 proc is the name of the original procedure.
763 size returns the size of the structure allocated. */
765 static struct sockaddr
*
766 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
767 const char *proc
, size_t *size
)
768 #define FUNC_NAME proc
774 struct sockaddr_in
*soka
;
778 SCM_VALIDATE_ULONG_COPY (which_arg
, address
, addr
);
779 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
780 port
= scm_to_int (SCM_CAR (*args
));
781 *args
= SCM_CDR (*args
);
782 soka
= (struct sockaddr_in
*) scm_malloc (sizeof (struct sockaddr_in
));
784 #if HAVE_STRUCT_SOCKADDR_SIN_LEN
785 soka
->sin_len
= sizeof (struct sockaddr_in
);
787 soka
->sin_family
= AF_INET
;
788 soka
->sin_addr
.s_addr
= htonl (addr
);
789 soka
->sin_port
= htons (port
);
790 *size
= sizeof (struct sockaddr_in
);
791 return (struct sockaddr
*) soka
;
798 struct sockaddr_in6
*soka
;
799 unsigned long flowinfo
= 0;
800 unsigned long scope_id
= 0;
802 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
803 port
= scm_to_int (SCM_CAR (*args
));
804 *args
= SCM_CDR (*args
);
805 if (scm_is_pair (*args
))
807 SCM_VALIDATE_ULONG_COPY (which_arg
+ 2, SCM_CAR (*args
), flowinfo
);
808 *args
= SCM_CDR (*args
);
809 if (scm_is_pair (*args
))
811 SCM_VALIDATE_ULONG_COPY (which_arg
+ 3, SCM_CAR (*args
),
813 *args
= SCM_CDR (*args
);
816 soka
= (struct sockaddr_in6
*) scm_malloc (sizeof (struct sockaddr_in6
));
818 #if HAVE_STRUCT_SOCKADDR_IN6_SIN6_LEN
819 soka
->sin6_len
= sizeof (struct sockaddr_in6
);
821 soka
->sin6_family
= AF_INET6
;
822 scm_to_ipv6 (soka
->sin6_addr
.s6_addr
, address
);
823 soka
->sin6_port
= htons (port
);
824 soka
->sin6_flowinfo
= flowinfo
;
825 #ifdef HAVE_SIN6_SCOPE_ID
826 soka
->sin6_scope_id
= scope_id
;
828 *size
= sizeof (struct sockaddr_in6
);
829 return (struct sockaddr
*) soka
;
832 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
835 struct sockaddr_un
*soka
;
839 scm_dynwind_begin (0);
841 c_address
= scm_to_locale_string (address
);
842 scm_dynwind_free (c_address
);
844 /* the static buffer size in sockaddr_un seems to be arbitrary
845 and not necessarily a hard limit. e.g., the glibc manual
846 suggests it may be possible to declare it size 0. let's
847 ignore it. if the O/S doesn't like the size it will cause
848 connect/bind etc., to fail. sun_path is always the last
849 member of the structure. */
850 addr_size
= sizeof (struct sockaddr_un
)
851 + max (0, strlen (c_address
) + 1 - (sizeof soka
->sun_path
));
852 soka
= (struct sockaddr_un
*) scm_malloc (addr_size
);
853 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
854 soka
->sun_family
= AF_UNIX
;
855 strcpy (soka
->sun_path
, c_address
);
856 *size
= SUN_LEN (soka
);
859 return (struct sockaddr
*) soka
;
863 scm_out_of_range (proc
, scm_from_int (fam
));
868 SCM_DEFINE (scm_connect
, "connect", 2, 1, 1,
869 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
870 "Initiate a connection from a socket using a specified address\n"
871 "family to the address\n"
872 "specified by @var{address} and possibly @var{args}.\n"
873 "The format required for @var{address}\n"
874 "and @var{args} depends on the family of the socket.\n\n"
875 "For a socket of family @code{AF_UNIX},\n"
876 "only @var{address} is specified and must be a string with the\n"
877 "filename where the socket is to be created.\n\n"
878 "For a socket of family @code{AF_INET},\n"
879 "@var{address} must be an integer IPv4 host address and\n"
880 "@var{args} must be a single integer port number.\n\n"
881 "For a socket of family @code{AF_INET6},\n"
882 "@var{address} must be an integer IPv6 host address and\n"
883 "@var{args} may be up to three integers:\n"
884 "port [flowinfo] [scope_id],\n"
885 "where flowinfo and scope_id default to zero.\n\n"
886 "Alternatively, the second argument can be a socket address object "
887 "as returned by @code{make-socket-address}, in which case the "
888 "no additional arguments should be passed.\n\n"
889 "The return value is unspecified.")
890 #define FUNC_NAME s_scm_connect
893 struct sockaddr
*soka
;
896 sock
= SCM_COERCE_OUTPORT (sock
);
897 SCM_VALIDATE_OPFPORT (1, sock
);
898 fd
= SCM_FPORT_FDES (sock
);
900 if (address
== SCM_UNDEFINED
)
901 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
902 `socket address' object. */
903 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
905 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
906 &args
, 3, FUNC_NAME
, &size
);
908 if (connect (fd
, soka
, size
) == -1)
910 int save_errno
= errno
;
917 return SCM_UNSPECIFIED
;
921 SCM_DEFINE (scm_bind
, "bind", 2, 1, 1,
922 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
923 "Assign an address to the socket port @var{sock}.\n"
924 "Generally this only needs to be done for server sockets,\n"
925 "so they know where to look for incoming connections. A socket\n"
926 "without an address will be assigned one automatically when it\n"
927 "starts communicating.\n\n"
928 "The format of @var{address} and @var{args} depends\n"
929 "on the family of the socket.\n\n"
930 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
931 "is specified and must be a string with the filename where\n"
932 "the socket is to be created.\n\n"
933 "For a socket of family @code{AF_INET}, @var{address}\n"
934 "must be an integer IPv4 address and @var{args}\n"
935 "must be a single integer port number.\n\n"
936 "The values of the following variables can also be used for\n"
938 "@defvar INADDR_ANY\n"
939 "Allow connections from any address.\n"
941 "@defvar INADDR_LOOPBACK\n"
942 "The address of the local host using the loopback device.\n"
944 "@defvar INADDR_BROADCAST\n"
945 "The broadcast address on the local network.\n"
947 "@defvar INADDR_NONE\n"
950 "For a socket of family @code{AF_INET6}, @var{address}\n"
951 "must be an integer IPv6 address and @var{args}\n"
952 "may be up to three integers:\n"
953 "port [flowinfo] [scope_id],\n"
954 "where flowinfo and scope_id default to zero.\n\n"
955 "Alternatively, the second argument can be a socket address object "
956 "as returned by @code{make-socket-address}, in which case the "
957 "no additional arguments should be passed.\n\n"
958 "The return value is unspecified.")
959 #define FUNC_NAME s_scm_bind
961 struct sockaddr
*soka
;
965 sock
= SCM_COERCE_OUTPORT (sock
);
966 SCM_VALIDATE_OPFPORT (1, sock
);
967 fd
= SCM_FPORT_FDES (sock
);
969 if (address
== SCM_UNDEFINED
)
970 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
971 `socket address' object. */
972 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
974 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
975 &args
, 3, FUNC_NAME
, &size
);
978 if (bind (fd
, soka
, size
) == -1)
980 int save_errno
= errno
;
987 return SCM_UNSPECIFIED
;
991 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
992 (SCM sock
, SCM backlog
),
993 "Enable @var{sock} to accept connection\n"
994 "requests. @var{backlog} is an integer specifying\n"
995 "the maximum length of the queue for pending connections.\n"
996 "If the queue fills, new clients will fail to connect until\n"
997 "the server calls @code{accept} to accept a connection from\n"
999 "The return value is unspecified.")
1000 #define FUNC_NAME s_scm_listen
1003 sock
= SCM_COERCE_OUTPORT (sock
);
1004 SCM_VALIDATE_OPFPORT (1, sock
);
1005 fd
= SCM_FPORT_FDES (sock
);
1006 if (listen (fd
, scm_to_int (backlog
)) == -1)
1008 return SCM_UNSPECIFIED
;
1012 /* Put the components of a sockaddr into a new SCM vector. */
1013 static SCM_C_INLINE_KEYWORD SCM
1014 _scm_from_sockaddr (const struct sockaddr
*address
, unsigned addr_size
,
1017 short int fam
= address
->sa_family
;
1018 SCM result
=SCM_EOL
;
1025 const struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
1027 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
1029 SCM_SIMPLE_VECTOR_SET(result
, 0,
1030 scm_from_short (fam
));
1031 SCM_SIMPLE_VECTOR_SET(result
, 1,
1032 scm_from_ulong (ntohl (nad
->sin_addr
.s_addr
)));
1033 SCM_SIMPLE_VECTOR_SET(result
, 2,
1034 scm_from_ushort (ntohs (nad
->sin_port
)));
1040 const struct sockaddr_in6
*nad
= (struct sockaddr_in6
*) address
;
1042 result
= scm_c_make_vector (5, SCM_UNSPECIFIED
);
1043 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1044 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_ipv6 (nad
->sin6_addr
.s6_addr
));
1045 SCM_SIMPLE_VECTOR_SET(result
, 2, scm_from_ushort (ntohs (nad
->sin6_port
)));
1046 SCM_SIMPLE_VECTOR_SET(result
, 3, scm_from_uint32 (nad
->sin6_flowinfo
));
1047 #ifdef HAVE_SIN6_SCOPE_ID
1048 SCM_SIMPLE_VECTOR_SET(result
, 4, scm_from_ulong (nad
->sin6_scope_id
));
1050 SCM_SIMPLE_VECTOR_SET(result
, 4, SCM_INUM0
);
1055 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1058 const struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
1060 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
1062 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1063 /* When addr_size is not enough to cover sun_path, do not try
1065 if (addr_size
<= offsetof (struct sockaddr_un
, sun_path
))
1066 SCM_SIMPLE_VECTOR_SET(result
, 1, SCM_BOOL_F
);
1068 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_locale_string (nad
->sun_path
));
1073 result
= SCM_UNSPECIFIED
;
1074 scm_misc_error (proc
, "unrecognised address family: ~A",
1075 scm_list_1 (scm_from_int (fam
)));
1081 /* The publicly-visible function. Return a Scheme object representing
1082 ADDRESS, an address of ADDR_SIZE bytes. */
1084 scm_from_sockaddr (const struct sockaddr
*address
, unsigned addr_size
)
1086 return (_scm_from_sockaddr (address
, addr_size
, "scm_from_sockaddr"));
1089 /* Convert ADDRESS, an address object returned by either
1090 `scm_from_sockaddr ()' or `scm_make_socket_address ()', into its C
1091 representation. On success, a non-NULL pointer is returned and
1092 ADDRESS_SIZE is updated to the actual size (in bytes) of the returned
1093 address. The result must eventually be freed using `free ()'. */
1095 scm_to_sockaddr (SCM address
, size_t *address_size
)
1096 #define FUNC_NAME "scm_to_sockaddr"
1099 struct sockaddr
*c_address
= NULL
;
1101 SCM_VALIDATE_VECTOR (1, address
);
1104 family
= scm_to_short (SCM_SIMPLE_VECTOR_REF (address
, 0));
1110 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 3)
1111 scm_misc_error (FUNC_NAME
,
1112 "invalid inet address representation: ~A",
1113 scm_list_1 (address
));
1116 struct sockaddr_in c_inet
;
1118 c_inet
.sin_addr
.s_addr
=
1119 htonl (scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 1)));
1121 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1122 c_inet
.sin_family
= AF_INET
;
1124 *address_size
= sizeof (c_inet
);
1125 c_address
= scm_malloc (sizeof (c_inet
));
1126 memcpy (c_address
, &c_inet
, sizeof (c_inet
));
1135 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 5)
1136 scm_misc_error (FUNC_NAME
, "invalid inet6 address representation: ~A",
1137 scm_list_1 (address
));
1140 struct sockaddr_in6 c_inet6
;
1142 scm_to_ipv6 (c_inet6
.sin6_addr
.s6_addr
, address
);
1144 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1145 c_inet6
.sin6_flowinfo
=
1146 scm_to_uint32 (SCM_SIMPLE_VECTOR_REF (address
, 3));
1147 #ifdef HAVE_SIN6_SCOPE_ID
1148 c_inet6
.sin6_scope_id
=
1149 scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 4));
1152 c_inet6
.sin6_family
= AF_INET6
;
1154 *address_size
= sizeof (c_inet6
);
1155 c_address
= scm_malloc (sizeof (c_inet6
));
1156 memcpy (c_address
, &c_inet6
, sizeof (c_inet6
));
1163 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1166 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 2)
1167 scm_misc_error (FUNC_NAME
, "invalid unix address representation: ~A",
1168 scm_list_1 (address
));
1172 size_t path_len
= 0;
1174 path
= SCM_SIMPLE_VECTOR_REF (address
, 1);
1175 if ((!scm_is_string (path
)) && (path
!= SCM_BOOL_F
))
1176 scm_misc_error (FUNC_NAME
, "invalid unix address "
1177 "path: ~A", scm_list_1 (path
));
1180 struct sockaddr_un c_unix
;
1182 if (path
== SCM_BOOL_F
)
1185 path_len
= scm_c_string_length (path
);
1187 #ifdef UNIX_PATH_MAX
1188 if (path_len
>= UNIX_PATH_MAX
)
1190 /* We can hope that this limit will eventually vanish, at least on GNU.
1191 However, currently, while glibc doesn't define `UNIX_PATH_MAX', it
1192 documents it has being limited to 108 bytes. */
1193 if (path_len
>= sizeof (c_unix
.sun_path
))
1195 scm_misc_error (FUNC_NAME
, "unix address path "
1196 "too long: ~A", scm_list_1 (path
));
1201 scm_to_locale_stringbuf (path
, c_unix
.sun_path
,
1202 #ifdef UNIX_PATH_MAX
1205 sizeof (c_unix
.sun_path
));
1207 c_unix
.sun_path
[path_len
] = '\0';
1210 if (strlen (c_unix
.sun_path
) != path_len
)
1211 scm_misc_error (FUNC_NAME
, "unix address path "
1212 "contains nul characters: ~A",
1216 c_unix
.sun_path
[0] = '\0';
1218 c_unix
.sun_family
= AF_UNIX
;
1220 *address_size
= SUN_LEN (&c_unix
);
1221 c_address
= scm_malloc (sizeof (c_unix
));
1222 memcpy (c_address
, &c_unix
, sizeof (c_unix
));
1232 scm_misc_error (FUNC_NAME
, "unrecognised address family: ~A",
1233 scm_list_1 (scm_from_ushort (family
)));
1241 /* Return a newly-allocated `sockaddr' structure that reflects ADDRESS, being
1242 an address of family FAMILY, with the family-specific parameters ARGS (see
1243 the description of `connect' for details). The returned structure may be
1244 freed using `free ()'. */
1246 scm_c_make_socket_address (SCM family
, SCM address
, SCM args
,
1247 size_t *address_size
)
1249 struct sockaddr
*soka
;
1251 soka
= scm_fill_sockaddr (scm_to_ushort (family
), address
, &args
, 1,
1252 "scm_c_make_socket_address", address_size
);
1257 SCM_DEFINE (scm_make_socket_address
, "make-socket-address", 2, 0, 1,
1258 (SCM family
, SCM address
, SCM args
),
1259 "Return a Scheme address object that reflects @var{address}, "
1260 "being an address of family @var{family}, with the "
1261 "family-specific parameters @var{args} (see the description of "
1262 "@code{connect} for details).")
1263 #define FUNC_NAME s_scm_make_socket_address
1265 struct sockaddr
*c_address
;
1266 size_t c_address_size
;
1268 c_address
= scm_c_make_socket_address (family
, address
, args
,
1273 return (scm_from_sockaddr (c_address
, c_address_size
));
1278 /* calculate the size of a buffer large enough to hold any supported
1279 sockaddr type. if the buffer isn't large enough, certain system
1280 calls will return a truncated address. */
1282 #if defined (HAVE_UNIX_DOMAIN_SOCKETS)
1283 #define MAX_SIZE_UN sizeof (struct sockaddr_un)
1285 #define MAX_SIZE_UN 0
1288 #if defined (HAVE_IPV6)
1289 #define MAX_SIZE_IN6 sizeof (struct sockaddr_in6)
1291 #define MAX_SIZE_IN6 0
1294 #define MAX_ADDR_SIZE max (max (sizeof (struct sockaddr_in), MAX_SIZE_IN6),\
1297 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
1299 "Accept a connection on a bound, listening socket.\n"
1301 "are no pending connections in the queue, wait until\n"
1302 "one is available unless the non-blocking option has been\n"
1303 "set on the socket.\n\n"
1304 "The return value is a\n"
1305 "pair in which the @emph{car} is a new socket port for the\n"
1307 "the @emph{cdr} is an object with address information about the\n"
1308 "client which initiated the connection.\n\n"
1309 "@var{sock} does not become part of the\n"
1310 "connection and will continue to accept new requests.")
1311 #define FUNC_NAME s_scm_accept
1317 socklen_t addr_size
= MAX_ADDR_SIZE
;
1318 char max_addr
[MAX_ADDR_SIZE
];
1319 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1321 sock
= SCM_COERCE_OUTPORT (sock
);
1322 SCM_VALIDATE_OPFPORT (1, sock
);
1323 fd
= SCM_FPORT_FDES (sock
);
1324 newfd
= accept (fd
, addr
, &addr_size
);
1327 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
1328 address
= _scm_from_sockaddr (addr
, addr_size
, FUNC_NAME
);
1329 return scm_cons (newsock
, address
);
1333 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
1335 "Return the address of @var{sock}, in the same form as the\n"
1336 "object returned by @code{accept}. On many systems the address\n"
1337 "of a socket in the @code{AF_FILE} namespace cannot be read.")
1338 #define FUNC_NAME s_scm_getsockname
1341 socklen_t addr_size
= MAX_ADDR_SIZE
;
1342 char max_addr
[MAX_ADDR_SIZE
];
1343 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1345 sock
= SCM_COERCE_OUTPORT (sock
);
1346 SCM_VALIDATE_OPFPORT (1, sock
);
1347 fd
= SCM_FPORT_FDES (sock
);
1348 if (getsockname (fd
, addr
, &addr_size
) == -1)
1350 return _scm_from_sockaddr (addr
, addr_size
, FUNC_NAME
);
1354 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
1356 "Return the address that @var{sock}\n"
1357 "is connected to, in the same form as the object returned by\n"
1358 "@code{accept}. On many systems the address of a socket in the\n"
1359 "@code{AF_FILE} namespace cannot be read.")
1360 #define FUNC_NAME s_scm_getpeername
1363 socklen_t addr_size
= MAX_ADDR_SIZE
;
1364 char max_addr
[MAX_ADDR_SIZE
];
1365 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1367 sock
= SCM_COERCE_OUTPORT (sock
);
1368 SCM_VALIDATE_OPFPORT (1, sock
);
1369 fd
= SCM_FPORT_FDES (sock
);
1370 if (getpeername (fd
, addr
, &addr_size
) == -1)
1372 return _scm_from_sockaddr (addr
, addr_size
, FUNC_NAME
);
1376 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
1377 (SCM sock
, SCM buf
, SCM flags
),
1378 "Receive data from a socket port.\n"
1379 "@var{sock} must already\n"
1380 "be bound to the address from which data is to be received.\n"
1381 "@var{buf} is a string into which\n"
1382 "the data will be written. The size of @var{buf} limits\n"
1384 "data which can be received: in the case of packet\n"
1385 "protocols, if a packet larger than this limit is encountered\n"
1387 "will be irrevocably lost.\n\n"
1388 "The optional @var{flags} argument is a value or\n"
1389 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1390 "The value returned is the number of bytes read from the\n"
1392 "Note that the data is read directly from the socket file\n"
1394 "any unread buffered port data is ignored.")
1395 #define FUNC_NAME s_scm_recv
1403 SCM_VALIDATE_OPFPORT (1, sock
);
1404 SCM_VALIDATE_STRING (2, buf
);
1405 if (SCM_UNBNDP (flags
))
1408 flg
= scm_to_int (flags
);
1409 fd
= SCM_FPORT_FDES (sock
);
1411 len
= scm_i_string_length (buf
);
1412 dest
= scm_i_string_writable_chars (buf
);
1413 SCM_SYSCALL (rv
= recv (fd
, dest
, len
, flg
));
1414 scm_i_string_stop_writing ();
1419 scm_remember_upto_here_1 (buf
);
1420 return scm_from_int (rv
);
1424 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
1425 (SCM sock
, SCM message
, SCM flags
),
1426 "Transmit the string @var{message} on a socket port @var{sock}.\n"
1427 "@var{sock} must already be bound to a destination address. The\n"
1428 "value returned is the number of bytes transmitted --\n"
1429 "it's possible for\n"
1430 "this to be less than the length of @var{message}\n"
1431 "if the socket is\n"
1432 "set to be non-blocking. The optional @var{flags} argument\n"
1434 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1435 "Note that the data is written directly to the socket\n"
1436 "file descriptor:\n"
1437 "any unflushed buffered port data is ignored.")
1438 #define FUNC_NAME s_scm_send
1446 sock
= SCM_COERCE_OUTPORT (sock
);
1447 SCM_VALIDATE_OPFPORT (1, sock
);
1448 SCM_VALIDATE_STRING (2, message
);
1449 if (SCM_UNBNDP (flags
))
1452 flg
= scm_to_int (flags
);
1453 fd
= SCM_FPORT_FDES (sock
);
1455 len
= scm_i_string_length (message
);
1456 src
= scm_i_string_writable_chars (message
);
1457 SCM_SYSCALL (rv
= send (fd
, src
, len
, flg
));
1458 scm_i_string_stop_writing ();
1463 scm_remember_upto_here_1 (message
);
1464 return scm_from_int (rv
);
1468 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
1469 (SCM sock
, SCM str
, SCM flags
, SCM start
, SCM end
),
1470 "Receive data from socket port @var{sock} (which must be already\n"
1471 "bound), returning the originating address as well as the data.\n"
1472 "This is usually for use on datagram sockets, but can be used on\n"
1473 "stream-oriented sockets too.\n"
1475 "The data received is stored in the given @var{str}, using\n"
1476 "either the whole string or just the region between the optional\n"
1477 "@var{start} and @var{end} positions. The size of @var{str}\n"
1478 "limits the amount of data which can be received. For datagram\n"
1479 "protocols, if a packet larger than this is received then excess\n"
1480 "bytes are irrevocably lost.\n"
1482 "The return value is a pair. The @code{car} is the number of\n"
1483 "bytes read. The @code{cdr} is a socket address object which is\n"
1484 "where the data come from, or @code{#f} if the origin is\n"
1487 "The optional @var{flags} argument is a or bitwise OR\n"
1488 "(@code{logior}) of @code{MSG_OOB}, @code{MSG_PEEK},\n"
1489 "@code{MSG_DONTROUTE} etc.\n"
1491 "Data is read directly from the socket file descriptor, any\n"
1492 "buffered port data is ignored.\n"
1494 "On a GNU/Linux system @code{recvfrom!} is not multi-threading,\n"
1495 "all threads stop while a @code{recvfrom!} call is in progress.\n"
1496 "An application may need to use @code{select}, @code{O_NONBLOCK}\n"
1497 "or @code{MSG_DONTWAIT} to avoid this.")
1498 #define FUNC_NAME s_scm_recvfrom
1507 socklen_t addr_size
= MAX_ADDR_SIZE
;
1508 char max_addr
[MAX_ADDR_SIZE
];
1509 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1511 SCM_VALIDATE_OPFPORT (1, sock
);
1512 fd
= SCM_FPORT_FDES (sock
);
1514 SCM_VALIDATE_STRING (2, str
);
1515 scm_i_get_substring_spec (scm_i_string_length (str
),
1516 start
, &offset
, end
, &cend
);
1518 if (SCM_UNBNDP (flags
))
1521 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
1523 /* recvfrom will not necessarily return an address. usually nothing
1524 is returned for stream sockets. */
1525 buf
= scm_i_string_writable_chars (str
);
1526 addr
->sa_family
= AF_UNSPEC
;
1527 SCM_SYSCALL (rv
= recvfrom (fd
, buf
+ offset
,
1530 scm_i_string_stop_writing ();
1534 if (addr
->sa_family
!= AF_UNSPEC
)
1535 address
= _scm_from_sockaddr (addr
, addr_size
, FUNC_NAME
);
1537 address
= SCM_BOOL_F
;
1539 scm_remember_upto_here_1 (str
);
1540 return scm_cons (scm_from_int (rv
), address
);
1544 SCM_DEFINE (scm_sendto
, "sendto", 3, 1, 1,
1545 (SCM sock
, SCM message
, SCM fam_or_sockaddr
, SCM address
, SCM args_and_flags
),
1546 "Transmit the string @var{message} on the socket port\n"
1548 "destination address is specified using the @var{fam},\n"
1549 "@var{address} and\n"
1550 "@var{args_and_flags} arguments, or just a socket address object "
1551 "returned by @code{make-socket-address}, in a similar way to the\n"
1552 "@code{connect} procedure. @var{args_and_flags} contains\n"
1553 "the usual connection arguments optionally followed by\n"
1554 "a flags argument, which is a value or\n"
1555 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1556 "The value returned is the number of bytes transmitted --\n"
1557 "it's possible for\n"
1558 "this to be less than the length of @var{message} if the\n"
1560 "set to be non-blocking.\n"
1561 "Note that the data is written directly to the socket\n"
1562 "file descriptor:\n"
1563 "any unflushed buffered port data is ignored.")
1564 #define FUNC_NAME s_scm_sendto
1569 struct sockaddr
*soka
;
1572 sock
= SCM_COERCE_OUTPORT (sock
);
1573 SCM_VALIDATE_FPORT (1, sock
);
1574 SCM_VALIDATE_STRING (2, message
);
1575 fd
= SCM_FPORT_FDES (sock
);
1577 if (!scm_is_number (fam_or_sockaddr
))
1579 /* FAM_OR_SOCKADDR must actually be a `socket address' object. This
1580 means that the following arguments, i.e. ADDRESS and those listed in
1581 ARGS_AND_FLAGS, are the `MSG_' flags. */
1582 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
1583 if (address
!= SCM_UNDEFINED
)
1584 args_and_flags
= scm_cons (address
, args_and_flags
);
1587 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
1588 &args_and_flags
, 3, FUNC_NAME
, &size
);
1590 if (scm_is_null (args_and_flags
))
1594 SCM_VALIDATE_CONS (5, args_and_flags
);
1595 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
1597 SCM_SYSCALL (rv
= sendto (fd
,
1598 scm_i_string_chars (message
),
1599 scm_i_string_length (message
),
1603 int save_errno
= errno
;
1610 scm_remember_upto_here_1 (message
);
1611 return scm_from_int (rv
);
1620 /* protocol families. */
1622 scm_c_define ("AF_UNSPEC", scm_from_int (AF_UNSPEC
));
1625 scm_c_define ("AF_UNIX", scm_from_int (AF_UNIX
));
1628 scm_c_define ("AF_INET", scm_from_int (AF_INET
));
1631 scm_c_define ("AF_INET6", scm_from_int (AF_INET6
));
1635 scm_c_define ("PF_UNSPEC", scm_from_int (PF_UNSPEC
));
1638 scm_c_define ("PF_UNIX", scm_from_int (PF_UNIX
));
1641 scm_c_define ("PF_INET", scm_from_int (PF_INET
));
1644 scm_c_define ("PF_INET6", scm_from_int (PF_INET6
));
1647 /* standard addresses. */
1649 scm_c_define ("INADDR_ANY", scm_from_ulong (INADDR_ANY
));
1651 #ifdef INADDR_BROADCAST
1652 scm_c_define ("INADDR_BROADCAST", scm_from_ulong (INADDR_BROADCAST
));
1655 scm_c_define ("INADDR_NONE", scm_from_ulong (INADDR_NONE
));
1657 #ifdef INADDR_LOOPBACK
1658 scm_c_define ("INADDR_LOOPBACK", scm_from_ulong (INADDR_LOOPBACK
));
1663 SOCK_PACKET is deliberately omitted, the GNU/Linux socket(2) and
1664 packet(7) advise that it's obsolete and strongly deprecated. */
1667 scm_c_define ("SOCK_STREAM", scm_from_int (SOCK_STREAM
));
1670 scm_c_define ("SOCK_DGRAM", scm_from_int (SOCK_DGRAM
));
1672 #ifdef SOCK_SEQPACKET
1673 scm_c_define ("SOCK_SEQPACKET", scm_from_int (SOCK_SEQPACKET
));
1676 scm_c_define ("SOCK_RAW", scm_from_int (SOCK_RAW
));
1679 scm_c_define ("SOCK_RDM", scm_from_int (SOCK_RDM
));
1682 /* setsockopt level.
1684 SOL_IP, SOL_TCP and SOL_UDP are defined on gnu/linux, but not on for
1685 instance NetBSD. We define IPPROTOs because that's what the posix spec
1686 shows in its example at
1688 http://www.opengroup.org/onlinepubs/007904975/functions/getsockopt.html
1691 scm_c_define ("SOL_SOCKET", scm_from_int (SOL_SOCKET
));
1694 scm_c_define ("IPPROTO_IP", scm_from_int (IPPROTO_IP
));
1697 scm_c_define ("IPPROTO_TCP", scm_from_int (IPPROTO_TCP
));
1700 scm_c_define ("IPPROTO_UDP", scm_from_int (IPPROTO_UDP
));
1703 /* setsockopt names. */
1705 scm_c_define ("SO_DEBUG", scm_from_int (SO_DEBUG
));
1708 scm_c_define ("SO_REUSEADDR", scm_from_int (SO_REUSEADDR
));
1711 scm_c_define ("SO_STYLE", scm_from_int (SO_STYLE
));
1714 scm_c_define ("SO_TYPE", scm_from_int (SO_TYPE
));
1717 scm_c_define ("SO_ERROR", scm_from_int (SO_ERROR
));
1720 scm_c_define ("SO_DONTROUTE", scm_from_int (SO_DONTROUTE
));
1723 scm_c_define ("SO_BROADCAST", scm_from_int (SO_BROADCAST
));
1726 scm_c_define ("SO_SNDBUF", scm_from_int (SO_SNDBUF
));
1729 scm_c_define ("SO_RCVBUF", scm_from_int (SO_RCVBUF
));
1732 scm_c_define ("SO_KEEPALIVE", scm_from_int (SO_KEEPALIVE
));
1735 scm_c_define ("SO_OOBINLINE", scm_from_int (SO_OOBINLINE
));
1738 scm_c_define ("SO_NO_CHECK", scm_from_int (SO_NO_CHECK
));
1741 scm_c_define ("SO_PRIORITY", scm_from_int (SO_PRIORITY
));
1744 scm_c_define ("SO_LINGER", scm_from_int (SO_LINGER
));
1747 /* recv/send options. */
1749 scm_c_define ("MSG_DONTWAIT", scm_from_int (MSG_DONTWAIT
));
1752 scm_c_define ("MSG_OOB", scm_from_int (MSG_OOB
));
1755 scm_c_define ("MSG_PEEK", scm_from_int (MSG_PEEK
));
1757 #ifdef MSG_DONTROUTE
1758 scm_c_define ("MSG_DONTROUTE", scm_from_int (MSG_DONTROUTE
));
1762 scm_i_init_socket_Win32 ();
1765 #ifdef IP_ADD_MEMBERSHIP
1766 scm_c_define ("IP_ADD_MEMBERSHIP", scm_from_int (IP_ADD_MEMBERSHIP
));
1767 scm_c_define ("IP_DROP_MEMBERSHIP", scm_from_int (IP_DROP_MEMBERSHIP
));
1770 scm_add_feature ("socket");
1772 #include "libguile/socket.x"