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"
39 #include "libguile/iselect.h"
42 #include "win32-socket.h"
54 #include <sys/types.h>
55 #ifdef HAVE_WINSOCK2_H
58 #include <sys/socket.h>
59 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
62 #include <netinet/in.h>
64 #include <arpa/inet.h>
67 #if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
68 #define SUN_LEN(ptr) ((size_t) (((struct sockaddr_un *) 0)->sun_path) \
69 + strlen ((ptr)->sun_path))
72 /* The largest possible socket address. Wrapping it in a union guarantees
73 that the compiler will make it suitably aligned. */
76 struct sockaddr sockaddr
;
77 struct sockaddr_in sockaddr_in
;
79 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
80 struct sockaddr_un sockaddr_un
;
83 struct sockaddr_in6 sockaddr_in6
;
88 /* Maximum size of a socket address. */
89 #define MAX_ADDR_SIZE (sizeof (scm_t_max_sockaddr))
94 SCM_DEFINE (scm_htons
, "htons", 1, 0, 0,
96 "Convert a 16 bit quantity from host to network byte ordering.\n"
97 "@var{value} is packed into 2 bytes, which are then converted\n"
98 "and returned as a new integer.")
99 #define FUNC_NAME s_scm_htons
101 return scm_from_ushort (htons (scm_to_ushort (value
)));
105 SCM_DEFINE (scm_ntohs
, "ntohs", 1, 0, 0,
107 "Convert a 16 bit quantity from network to host byte ordering.\n"
108 "@var{value} is packed into 2 bytes, which are then converted\n"
109 "and returned as a new integer.")
110 #define FUNC_NAME s_scm_ntohs
112 return scm_from_ushort (ntohs (scm_to_ushort (value
)));
116 SCM_DEFINE (scm_htonl
, "htonl", 1, 0, 0,
118 "Convert a 32 bit quantity from host to network byte ordering.\n"
119 "@var{value} is packed into 4 bytes, which are then converted\n"
120 "and returned as a new integer.")
121 #define FUNC_NAME s_scm_htonl
123 return scm_from_ulong (htonl (scm_to_uint32 (value
)));
127 SCM_DEFINE (scm_ntohl
, "ntohl", 1, 0, 0,
129 "Convert a 32 bit quantity from network to host byte ordering.\n"
130 "@var{value} is packed into 4 bytes, which are then converted\n"
131 "and returned as a new integer.")
132 #define FUNC_NAME s_scm_ntohl
134 return scm_from_ulong (ntohl (scm_to_uint32 (value
)));
138 #ifndef HAVE_INET_ATON
139 /* for our definition in inet_aton.c, not usually needed. */
140 extern int inet_aton ();
143 SCM_DEFINE (scm_inet_aton
, "inet-aton", 1, 0, 0,
145 "Convert an IPv4 Internet address from printable string\n"
146 "(dotted decimal notation) to an integer. E.g.,\n\n"
148 "(inet-aton \"127.0.0.1\") @result{} 2130706433\n"
150 #define FUNC_NAME s_scm_inet_aton
156 c_address
= scm_to_locale_string (address
);
157 rv
= inet_aton (c_address
, &soka
);
160 SCM_MISC_ERROR ("bad address", SCM_EOL
);
161 return scm_from_ulong (ntohl (soka
.s_addr
));
166 SCM_DEFINE (scm_inet_ntoa
, "inet-ntoa", 1, 0, 0,
168 "Convert an IPv4 Internet address to a printable\n"
169 "(dotted decimal notation) string. E.g.,\n\n"
171 "(inet-ntoa 2130706433) @result{} \"127.0.0.1\"\n"
173 #define FUNC_NAME s_scm_inet_ntoa
178 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, inetid
));
179 s
= inet_ntoa (addr
);
180 answer
= scm_from_locale_string (s
);
185 #ifdef HAVE_INET_NETOF
186 SCM_DEFINE (scm_inet_netof
, "inet-netof", 1, 0, 0,
188 "Return the network number part of the given IPv4\n"
189 "Internet address. E.g.,\n\n"
191 "(inet-netof 2130706433) @result{} 127\n"
193 #define FUNC_NAME s_scm_inet_netof
196 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
197 return scm_from_ulong (inet_netof (addr
));
202 #ifdef HAVE_INET_LNAOF
203 SCM_DEFINE (scm_lnaof
, "inet-lnaof", 1, 0, 0,
205 "Return the local-address-with-network part of the given\n"
206 "IPv4 Internet address, using the obsolete class A/B/C system.\n"
209 "(inet-lnaof 2130706433) @result{} 1\n"
211 #define FUNC_NAME s_scm_lnaof
214 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
215 return scm_from_ulong (inet_lnaof (addr
));
220 #ifdef HAVE_INET_MAKEADDR
221 SCM_DEFINE (scm_inet_makeaddr
, "inet-makeaddr", 2, 0, 0,
223 "Make an IPv4 Internet address by combining the network number\n"
224 "@var{net} with the local-address-within-network number\n"
225 "@var{lna}. E.g.,\n\n"
227 "(inet-makeaddr 127 1) @result{} 2130706433\n"
229 #define FUNC_NAME s_scm_inet_makeaddr
232 unsigned long netnum
;
233 unsigned long lnanum
;
235 netnum
= SCM_NUM2ULONG (1, net
);
236 lnanum
= SCM_NUM2ULONG (2, lna
);
237 addr
= inet_makeaddr (netnum
, lnanum
);
238 return scm_from_ulong (ntohl (addr
.s_addr
));
245 /* flip a 128 bit IPv6 address between host and network order. */
246 #ifdef WORDS_BIGENDIAN
247 #define FLIP_NET_HOST_128(addr)
249 #define FLIP_NET_HOST_128(addr)\
253 for (i = 0; i < 8; i++)\
255 scm_t_uint8 c = (addr)[i];\
257 (addr)[i] = (addr)[15 - i];\
263 #ifdef WORDS_BIGENDIAN
264 #define FLIPCPY_NET_HOST_128(dest, src) memcpy (dest, src, 16)
266 #define FLIPCPY_NET_HOST_128(dest, src) \
268 const scm_t_uint8 *tmp_srcp = (src) + 15; \
269 scm_t_uint8 *tmp_destp = (dest); \
272 *tmp_destp++ = *tmp_srcp--; \
273 } while (tmp_srcp != (src)); \
278 #if (SIZEOF_SCM_T_BITS * SCM_CHAR_BIT) > 128
279 #error "Assumption that scm_t_bits <= 128 bits has been violated."
282 #if (SIZEOF_UNSIGNED_LONG * SCM_CHAR_BIT) > 128
283 #error "Assumption that unsigned long <= 128 bits has been violated."
286 #if (SIZEOF_UNSIGNED_LONG_LONG * SCM_CHAR_BIT) > 128
287 #error "Assumption that unsigned long long <= 128 bits has been violated."
290 /* convert a 128 bit IPv6 address in network order to a host ordered
293 scm_from_ipv6 (const scm_t_uint8
*src
)
295 SCM result
= scm_i_mkbig ();
296 mpz_import (SCM_I_BIG_MPZ (result
),
298 1, /* big-endian chunk ordering */
299 16, /* chunks are 16 bytes long */
300 1, /* big-endian byte ordering */
301 0, /* "nails" -- leading unused bits per chunk */
303 return scm_i_normbig (result
);
306 /* convert a host ordered SCM integer to a 128 bit IPv6 address in
309 scm_to_ipv6 (scm_t_uint8 dst
[16], SCM src
)
311 if (SCM_I_INUMP (src
))
313 scm_t_signed_bits n
= SCM_I_INUM (src
);
315 scm_out_of_range (NULL
, src
);
316 #ifdef WORDS_BIGENDIAN
317 memset (dst
, 0, 16 - sizeof (scm_t_signed_bits
));
318 memcpy (dst
+ (16 - sizeof (scm_t_signed_bits
)),
320 sizeof (scm_t_signed_bits
));
322 memset (dst
+ sizeof (scm_t_signed_bits
),
324 16 - sizeof (scm_t_signed_bits
));
325 /* FIXME: this pair of ops is kinda wasteful -- should rewrite as
326 a single loop perhaps, similar to the handling of bignums. */
327 memcpy (dst
, &n
, sizeof (scm_t_signed_bits
));
328 FLIP_NET_HOST_128 (dst
);
331 else if (SCM_BIGP (src
))
335 if ((mpz_sgn (SCM_I_BIG_MPZ (src
)) < 0)
336 || mpz_sizeinbase (SCM_I_BIG_MPZ (src
), 2) > 128)
337 scm_out_of_range (NULL
, src
);
342 1, /* big-endian chunk ordering */
343 16, /* chunks are 16 bytes long */
344 1, /* big-endian byte ordering */
345 0, /* "nails" -- leading unused bits per chunk */
346 SCM_I_BIG_MPZ (src
));
347 scm_remember_upto_here_1 (src
);
350 scm_wrong_type_arg (NULL
, 0, src
);
353 #ifdef HAVE_INET_PTON
354 SCM_DEFINE (scm_inet_pton
, "inet-pton", 2, 0, 0,
355 (SCM family
, SCM address
),
356 "Convert a string containing a printable network address to\n"
357 "an integer address. Note that unlike the C version of this\n"
359 "the result is an integer with normal host byte ordering.\n"
360 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
362 "(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
363 "(inet-pton AF_INET6 \"::1\") @result{} 1\n"
365 #define FUNC_NAME s_scm_inet_pton
372 af
= scm_to_int (family
);
373 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
374 src
= scm_to_locale_string (address
);
375 rv
= inet_pton (af
, src
, dst
);
382 SCM_MISC_ERROR ("Bad address", SCM_EOL
);
384 return scm_from_ulong (ntohl (*dst
));
386 return scm_from_ipv6 ((scm_t_uint8
*) dst
);
391 #ifdef HAVE_INET_NTOP
392 SCM_DEFINE (scm_inet_ntop
, "inet-ntop", 2, 0, 0,
393 (SCM family
, SCM address
),
394 "Convert a network address into a printable string.\n"
395 "Note that unlike the C version of this function,\n"
396 "the input is an integer with normal host byte ordering.\n"
397 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
399 "(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
400 "(inet-ntop AF_INET6 (- (expt 2 128) 1)) @result{}\n"
401 "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\n"
403 #define FUNC_NAME s_scm_inet_ntop
406 #ifdef INET6_ADDRSTRLEN
407 char dst
[INET6_ADDRSTRLEN
];
413 af
= scm_to_int (family
);
414 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
419 addr4
= htonl (SCM_NUM2ULONG (2, address
));
420 result
= inet_ntop (af
, &addr4
, dst
, sizeof (dst
));
426 scm_to_ipv6 ((scm_t_uint8
*) addr6
, address
);
427 result
= inet_ntop (af
, &addr6
, dst
, sizeof (dst
));
433 return scm_from_locale_string (dst
);
438 #endif /* HAVE_IPV6 */
440 SCM_SYMBOL (sym_socket
, "socket");
442 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
444 SCM_DEFINE (scm_socket
, "socket", 3, 0, 0,
445 (SCM family
, SCM style
, SCM proto
),
446 "Return a new socket port of the type specified by @var{family},\n"
447 "@var{style} and @var{proto}. All three parameters are\n"
448 "integers. Supported values for @var{family} are\n"
449 "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
450 "Typical values for @var{style} are @code{SOCK_STREAM},\n"
451 "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
452 "@var{proto} can be obtained from a protocol name using\n"
453 "@code{getprotobyname}. A value of zero specifies the default\n"
454 "protocol, which is usually right.\n\n"
455 "A single socket port cannot by used for communication until it\n"
456 "has been connected to another socket.")
457 #define FUNC_NAME s_scm_socket
461 fd
= socket (scm_to_int (family
),
466 return SCM_SOCK_FD_TO_PORT (fd
);
470 #ifdef HAVE_SOCKETPAIR
471 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
472 (SCM family
, SCM style
, SCM proto
),
473 "Return a pair of connected (but unnamed) socket ports of the\n"
474 "type specified by @var{family}, @var{style} and @var{proto}.\n"
475 "Many systems support only socket pairs of the @code{AF_UNIX}\n"
476 "family. Zero is likely to be the only meaningful value for\n"
478 #define FUNC_NAME s_scm_socketpair
483 fam
= scm_to_int (family
);
485 if (socketpair (fam
, scm_to_int (style
), scm_to_int (proto
), fd
) == -1)
488 return scm_cons (SCM_SOCK_FD_TO_PORT (fd
[0]), SCM_SOCK_FD_TO_PORT (fd
[1]));
493 /* Possible results for `getsockopt ()'. Wrapping it into a union guarantees
494 suitable alignment. */
497 #ifdef HAVE_STRUCT_LINGER
498 struct linger linger
;
502 } scm_t_getsockopt_result
;
504 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
505 (SCM sock
, SCM level
, SCM optname
),
506 "Return an option value from socket port @var{sock}.\n"
508 "@var{level} is an integer specifying a protocol layer, either\n"
509 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
510 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
511 "(@pxref{Network Databases}).\n"
513 "@defvar SOL_SOCKET\n"
514 "@defvarx IPPROTO_IP\n"
515 "@defvarx IPPROTO_TCP\n"
516 "@defvarx IPPROTO_UDP\n"
519 "@var{optname} is an integer specifying an option within the\n"
522 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
523 "defined (when provided by the system). For their meaning see\n"
524 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
525 "Manual}, or @command{man 7 socket}.\n"
528 "@defvarx SO_REUSEADDR\n"
529 "@defvarx SO_STYLE\n"
531 "@defvarx SO_ERROR\n"
532 "@defvarx SO_DONTROUTE\n"
533 "@defvarx SO_BROADCAST\n"
534 "@defvarx SO_SNDBUF\n"
535 "@defvarx SO_RCVBUF\n"
536 "@defvarx SO_KEEPALIVE\n"
537 "@defvarx SO_OOBINLINE\n"
538 "@defvarx SO_NO_CHECK\n"
539 "@defvarx SO_PRIORITY\n"
540 "The value returned is an integer.\n"
543 "@defvar SO_LINGER\n"
544 "The @var{value} returned is a pair of integers\n"
545 "@code{(@var{ENABLE} . @var{TIMEOUT})}. On old systems without\n"
546 "timeout support (ie.@: without @code{struct linger}), only\n"
547 "@var{ENABLE} has an effect but the value in Guile is always a\n"
550 #define FUNC_NAME s_scm_getsockopt
553 /* size of optval is the largest supported option. */
554 scm_t_getsockopt_result optval
;
555 socklen_t optlen
= sizeof (optval
);
559 sock
= SCM_COERCE_OUTPORT (sock
);
560 SCM_VALIDATE_OPFPORT (1, sock
);
561 ilevel
= scm_to_int (level
);
562 ioptname
= scm_to_int (optname
);
564 fd
= SCM_FPORT_FDES (sock
);
565 if (getsockopt (fd
, ilevel
, ioptname
, (void *) &optval
, &optlen
) == -1)
568 if (ilevel
== SOL_SOCKET
)
571 if (ioptname
== SO_LINGER
)
573 #ifdef HAVE_STRUCT_LINGER
574 struct linger
*ling
= (struct linger
*) &optval
;
576 return scm_cons (scm_from_long (ling
->l_onoff
),
577 scm_from_long (ling
->l_linger
));
579 return scm_cons (scm_from_long (*(int *) &optval
),
587 || ioptname
== SO_SNDBUF
590 || ioptname
== SO_RCVBUF
594 return scm_from_size_t (*(size_t *) &optval
);
597 return scm_from_int (*(int *) &optval
);
601 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
602 (SCM sock
, SCM level
, SCM optname
, SCM value
),
603 "Set an option on socket port @var{sock}. The return value is\n"
606 "@var{level} is an integer specifying a protocol layer, either\n"
607 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
608 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
609 "(@pxref{Network Databases}).\n"
611 "@defvar SOL_SOCKET\n"
612 "@defvarx IPPROTO_IP\n"
613 "@defvarx IPPROTO_TCP\n"
614 "@defvarx IPPROTO_UDP\n"
617 "@var{optname} is an integer specifying an option within the\n"
620 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
621 "defined (when provided by the system). For their meaning see\n"
622 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
623 "Manual}, or @command{man 7 socket}.\n"
626 "@defvarx SO_REUSEADDR\n"
627 "@defvarx SO_STYLE\n"
629 "@defvarx SO_ERROR\n"
630 "@defvarx SO_DONTROUTE\n"
631 "@defvarx SO_BROADCAST\n"
632 "@defvarx SO_SNDBUF\n"
633 "@defvarx SO_RCVBUF\n"
634 "@defvarx SO_KEEPALIVE\n"
635 "@defvarx SO_OOBINLINE\n"
636 "@defvarx SO_NO_CHECK\n"
637 "@defvarx SO_PRIORITY\n"
638 "@var{value} is an integer.\n"
641 "@defvar SO_LINGER\n"
642 "@var{value} is a pair of integers @code{(@var{ENABLE}\n"
643 ". @var{TIMEOUT})}. On old systems without timeout support\n"
644 "(ie.@: without @code{struct linger}), only @var{ENABLE} has an\n"
645 "effect but the value in Guile is always a pair.\n"
648 "@c Note that we refer only to ``man ip'' here. On GNU/Linux it's\n"
649 "@c ``man 7 ip'' but on NetBSD it's ``man 4 ip''.\n"
651 "For IP level (@code{IPPROTO_IP}) the following @var{optname}s\n"
652 "are defined (when provided by the system). See @command{man\n"
653 "ip} for what they mean.\n"
655 "@defvar IP_ADD_MEMBERSHIP\n"
656 "@defvarx IP_DROP_MEMBERSHIP\n"
657 "These can be used only with @code{setsockopt}, not\n"
658 "@code{getsockopt}. @var{value} is a pair\n"
659 "@code{(@var{MULTIADDR} . @var{INTERFACEADDR})} of IPv4\n"
660 "addresses (@pxref{Network Address Conversion}).\n"
661 "@var{MULTIADDR} is a multicast address to be added to or\n"
662 "dropped from the interface @var{INTERFACEADDR}.\n"
663 "@var{INTERFACEADDR} can be @code{INADDR_ANY} to have the system\n"
664 "select the interface. @var{INTERFACEADDR} can also be an\n"
665 "interface index number, on systems supporting that.\n"
667 #define FUNC_NAME s_scm_setsockopt
672 #ifdef HAVE_STRUCT_LINGER
673 struct linger opt_linger
;
676 #if HAVE_STRUCT_IP_MREQ
677 struct ip_mreq opt_mreq
;
680 const void *optval
= NULL
;
681 socklen_t optlen
= 0;
683 int ilevel
, ioptname
;
685 sock
= SCM_COERCE_OUTPORT (sock
);
687 SCM_VALIDATE_OPFPORT (1, sock
);
688 ilevel
= scm_to_int (level
);
689 ioptname
= scm_to_int (optname
);
691 fd
= SCM_FPORT_FDES (sock
);
693 if (ilevel
== SOL_SOCKET
)
696 if (ioptname
== SO_LINGER
)
698 #ifdef HAVE_STRUCT_LINGER
699 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
700 opt_linger
.l_onoff
= scm_to_int (SCM_CAR (value
));
701 opt_linger
.l_linger
= scm_to_int (SCM_CDR (value
));
702 optlen
= sizeof (struct linger
);
703 optval
= &opt_linger
;
705 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
706 opt_int
= scm_to_int (SCM_CAR (value
));
707 /* timeout is ignored, but may as well validate it. */
708 scm_to_int (SCM_CDR (value
));
709 optlen
= sizeof (int);
717 || ioptname
== SO_SNDBUF
720 || ioptname
== SO_RCVBUF
724 opt_int
= scm_to_int (value
);
725 optlen
= sizeof (size_t);
730 #if HAVE_STRUCT_IP_MREQ
731 if (ilevel
== IPPROTO_IP
&&
732 (ioptname
== IP_ADD_MEMBERSHIP
|| ioptname
== IP_DROP_MEMBERSHIP
))
734 /* Fourth argument must be a pair of addresses. */
735 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
736 opt_mreq
.imr_multiaddr
.s_addr
= htonl (scm_to_ulong (SCM_CAR (value
)));
737 opt_mreq
.imr_interface
.s_addr
= htonl (scm_to_ulong (SCM_CDR (value
)));
738 optlen
= sizeof (opt_mreq
);
745 /* Most options take an int. */
746 opt_int
= scm_to_int (value
);
747 optlen
= sizeof (int);
751 if (setsockopt (fd
, ilevel
, ioptname
, optval
, optlen
) == -1)
753 return SCM_UNSPECIFIED
;
757 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
759 "Sockets can be closed simply by using @code{close-port}. The\n"
760 "@code{shutdown} procedure allows reception or transmission on a\n"
761 "connection to be shut down individually, according to the parameter\n"
765 "Stop receiving data for this socket. If further data arrives, reject it.\n"
767 "Stop trying to transmit data from this socket. Discard any\n"
768 "data waiting to be sent. Stop looking for acknowledgement of\n"
769 "data already sent; don't retransmit it if it is lost.\n"
771 "Stop both reception and transmission.\n"
773 "The return value is unspecified.")
774 #define FUNC_NAME s_scm_shutdown
777 sock
= SCM_COERCE_OUTPORT (sock
);
778 SCM_VALIDATE_OPFPORT (1, sock
);
779 fd
= SCM_FPORT_FDES (sock
);
780 if (shutdown (fd
, scm_to_signed_integer (how
, 0, 2)) == -1)
782 return SCM_UNSPECIFIED
;
786 /* convert fam/address/args into a sockaddr of the appropriate type.
787 args is modified by removing the arguments actually used.
788 which_arg and proc are used when reporting errors:
789 which_arg is the position of address in the original argument list.
790 proc is the name of the original procedure.
791 size returns the size of the structure allocated. */
793 static struct sockaddr
*
794 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
795 const char *proc
, size_t *size
)
796 #define FUNC_NAME proc
802 struct sockaddr_in
*soka
;
806 SCM_VALIDATE_ULONG_COPY (which_arg
, address
, addr
);
807 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
808 port
= scm_to_int (SCM_CAR (*args
));
809 *args
= SCM_CDR (*args
);
810 soka
= (struct sockaddr_in
*) scm_malloc (sizeof (struct sockaddr_in
));
812 #if HAVE_STRUCT_SOCKADDR_SIN_LEN
813 soka
->sin_len
= sizeof (struct sockaddr_in
);
815 soka
->sin_family
= AF_INET
;
816 soka
->sin_addr
.s_addr
= htonl (addr
);
817 soka
->sin_port
= htons (port
);
818 *size
= sizeof (struct sockaddr_in
);
819 return (struct sockaddr
*) soka
;
826 struct sockaddr_in6
*soka
;
827 unsigned long flowinfo
= 0;
828 unsigned long scope_id
= 0;
830 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
831 port
= scm_to_int (SCM_CAR (*args
));
832 *args
= SCM_CDR (*args
);
833 if (scm_is_pair (*args
))
835 SCM_VALIDATE_ULONG_COPY (which_arg
+ 2, SCM_CAR (*args
), flowinfo
);
836 *args
= SCM_CDR (*args
);
837 if (scm_is_pair (*args
))
839 SCM_VALIDATE_ULONG_COPY (which_arg
+ 3, SCM_CAR (*args
),
841 *args
= SCM_CDR (*args
);
844 soka
= (struct sockaddr_in6
*) scm_malloc (sizeof (struct sockaddr_in6
));
846 #if HAVE_STRUCT_SOCKADDR_IN6_SIN6_LEN
847 soka
->sin6_len
= sizeof (struct sockaddr_in6
);
849 soka
->sin6_family
= AF_INET6
;
850 scm_to_ipv6 (soka
->sin6_addr
.s6_addr
, address
);
851 soka
->sin6_port
= htons (port
);
852 soka
->sin6_flowinfo
= flowinfo
;
853 #ifdef HAVE_SIN6_SCOPE_ID
854 soka
->sin6_scope_id
= scope_id
;
856 *size
= sizeof (struct sockaddr_in6
);
857 return (struct sockaddr
*) soka
;
860 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
863 struct sockaddr_un
*soka
;
867 scm_dynwind_begin (0);
869 c_address
= scm_to_locale_string (address
);
870 scm_dynwind_free (c_address
);
872 /* the static buffer size in sockaddr_un seems to be arbitrary
873 and not necessarily a hard limit. e.g., the glibc manual
874 suggests it may be possible to declare it size 0. let's
875 ignore it. if the O/S doesn't like the size it will cause
876 connect/bind etc., to fail. sun_path is always the last
877 member of the structure. */
878 addr_size
= sizeof (struct sockaddr_un
)
879 + max (0, strlen (c_address
) + 1 - (sizeof soka
->sun_path
));
880 soka
= (struct sockaddr_un
*) scm_malloc (addr_size
);
881 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
882 soka
->sun_family
= AF_UNIX
;
883 strcpy (soka
->sun_path
, c_address
);
884 *size
= SUN_LEN (soka
);
887 return (struct sockaddr
*) soka
;
891 scm_out_of_range (proc
, scm_from_int (fam
));
896 SCM_DEFINE (scm_connect
, "connect", 2, 1, 1,
897 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
898 "Initiate a connection from a socket using a specified address\n"
899 "family to the address\n"
900 "specified by @var{address} and possibly @var{args}.\n"
901 "The format required for @var{address}\n"
902 "and @var{args} depends on the family of the socket.\n\n"
903 "For a socket of family @code{AF_UNIX},\n"
904 "only @var{address} is specified and must be a string with the\n"
905 "filename where the socket is to be created.\n\n"
906 "For a socket of family @code{AF_INET},\n"
907 "@var{address} must be an integer IPv4 host address and\n"
908 "@var{args} must be a single integer port number.\n\n"
909 "For a socket of family @code{AF_INET6},\n"
910 "@var{address} must be an integer IPv6 host address and\n"
911 "@var{args} may be up to three integers:\n"
912 "port [flowinfo] [scope_id],\n"
913 "where flowinfo and scope_id default to zero.\n\n"
914 "Alternatively, the second argument can be a socket address object "
915 "as returned by @code{make-socket-address}, in which case the "
916 "no additional arguments should be passed.\n\n"
917 "The return value is unspecified.")
918 #define FUNC_NAME s_scm_connect
921 struct sockaddr
*soka
;
924 sock
= SCM_COERCE_OUTPORT (sock
);
925 SCM_VALIDATE_OPFPORT (1, sock
);
926 fd
= SCM_FPORT_FDES (sock
);
928 if (address
== SCM_UNDEFINED
)
929 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
930 `socket address' object. */
931 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
933 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
934 &args
, 3, FUNC_NAME
, &size
);
936 if (connect (fd
, soka
, size
) == -1)
938 int save_errno
= errno
;
945 return SCM_UNSPECIFIED
;
949 SCM_DEFINE (scm_bind
, "bind", 2, 1, 1,
950 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
951 "Assign an address to the socket port @var{sock}.\n"
952 "Generally this only needs to be done for server sockets,\n"
953 "so they know where to look for incoming connections. A socket\n"
954 "without an address will be assigned one automatically when it\n"
955 "starts communicating.\n\n"
956 "The format of @var{address} and @var{args} depends\n"
957 "on the family of the socket.\n\n"
958 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
959 "is specified and must be a string with the filename where\n"
960 "the socket is to be created.\n\n"
961 "For a socket of family @code{AF_INET}, @var{address}\n"
962 "must be an integer IPv4 address and @var{args}\n"
963 "must be a single integer port number.\n\n"
964 "The values of the following variables can also be used for\n"
966 "@defvar INADDR_ANY\n"
967 "Allow connections from any address.\n"
969 "@defvar INADDR_LOOPBACK\n"
970 "The address of the local host using the loopback device.\n"
972 "@defvar INADDR_BROADCAST\n"
973 "The broadcast address on the local network.\n"
975 "@defvar INADDR_NONE\n"
978 "For a socket of family @code{AF_INET6}, @var{address}\n"
979 "must be an integer IPv6 address and @var{args}\n"
980 "may be up to three integers:\n"
981 "port [flowinfo] [scope_id],\n"
982 "where flowinfo and scope_id default to zero.\n\n"
983 "Alternatively, the second argument can be a socket address object "
984 "as returned by @code{make-socket-address}, in which case the "
985 "no additional arguments should be passed.\n\n"
986 "The return value is unspecified.")
987 #define FUNC_NAME s_scm_bind
989 struct sockaddr
*soka
;
993 sock
= SCM_COERCE_OUTPORT (sock
);
994 SCM_VALIDATE_OPFPORT (1, sock
);
995 fd
= SCM_FPORT_FDES (sock
);
997 if (address
== SCM_UNDEFINED
)
998 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
999 `socket address' object. */
1000 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
1002 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
1003 &args
, 3, FUNC_NAME
, &size
);
1006 if (bind (fd
, soka
, size
) == -1)
1008 int save_errno
= errno
;
1015 return SCM_UNSPECIFIED
;
1019 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
1020 (SCM sock
, SCM backlog
),
1021 "Enable @var{sock} to accept connection\n"
1022 "requests. @var{backlog} is an integer specifying\n"
1023 "the maximum length of the queue for pending connections.\n"
1024 "If the queue fills, new clients will fail to connect until\n"
1025 "the server calls @code{accept} to accept a connection from\n"
1027 "The return value is unspecified.")
1028 #define FUNC_NAME s_scm_listen
1031 sock
= SCM_COERCE_OUTPORT (sock
);
1032 SCM_VALIDATE_OPFPORT (1, sock
);
1033 fd
= SCM_FPORT_FDES (sock
);
1034 if (listen (fd
, scm_to_int (backlog
)) == -1)
1036 return SCM_UNSPECIFIED
;
1040 /* Put the components of a sockaddr into a new SCM vector. */
1041 static SCM_C_INLINE_KEYWORD SCM
1042 _scm_from_sockaddr (const scm_t_max_sockaddr
*address
, unsigned addr_size
,
1045 SCM result
= SCM_EOL
;
1046 short int fam
= ((struct sockaddr
*) address
)->sa_family
;
1052 const struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
1054 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
1056 SCM_SIMPLE_VECTOR_SET(result
, 0,
1057 scm_from_short (fam
));
1058 SCM_SIMPLE_VECTOR_SET(result
, 1,
1059 scm_from_ulong (ntohl (nad
->sin_addr
.s_addr
)));
1060 SCM_SIMPLE_VECTOR_SET(result
, 2,
1061 scm_from_ushort (ntohs (nad
->sin_port
)));
1067 const struct sockaddr_in6
*nad
= (struct sockaddr_in6
*) address
;
1069 result
= scm_c_make_vector (5, SCM_UNSPECIFIED
);
1070 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1071 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_ipv6 (nad
->sin6_addr
.s6_addr
));
1072 SCM_SIMPLE_VECTOR_SET(result
, 2, scm_from_ushort (ntohs (nad
->sin6_port
)));
1073 SCM_SIMPLE_VECTOR_SET(result
, 3, scm_from_uint32 (nad
->sin6_flowinfo
));
1074 #ifdef HAVE_SIN6_SCOPE_ID
1075 SCM_SIMPLE_VECTOR_SET(result
, 4, scm_from_ulong (nad
->sin6_scope_id
));
1077 SCM_SIMPLE_VECTOR_SET(result
, 4, SCM_INUM0
);
1082 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1085 const struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
1087 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
1089 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1090 /* When addr_size is not enough to cover sun_path, do not try
1092 if (addr_size
<= offsetof (struct sockaddr_un
, sun_path
))
1093 SCM_SIMPLE_VECTOR_SET(result
, 1, SCM_BOOL_F
);
1095 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_locale_string (nad
->sun_path
));
1100 result
= SCM_UNSPECIFIED
;
1101 scm_misc_error (proc
, "unrecognised address family: ~A",
1102 scm_list_1 (scm_from_int (fam
)));
1108 /* The publicly-visible function. Return a Scheme object representing
1109 ADDRESS, an address of ADDR_SIZE bytes. */
1111 scm_from_sockaddr (const struct sockaddr
*address
, unsigned addr_size
)
1113 return (_scm_from_sockaddr ((scm_t_max_sockaddr
*) address
,
1114 addr_size
, "scm_from_sockaddr"));
1117 /* Convert ADDRESS, an address object returned by either
1118 `scm_from_sockaddr ()' or `scm_make_socket_address ()', into its C
1119 representation. On success, a non-NULL pointer is returned and
1120 ADDRESS_SIZE is updated to the actual size (in bytes) of the returned
1121 address. The result must eventually be freed using `free ()'. */
1123 scm_to_sockaddr (SCM address
, size_t *address_size
)
1124 #define FUNC_NAME "scm_to_sockaddr"
1127 struct sockaddr
*c_address
= NULL
;
1129 SCM_VALIDATE_VECTOR (1, address
);
1132 family
= scm_to_short (SCM_SIMPLE_VECTOR_REF (address
, 0));
1138 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 3)
1139 scm_misc_error (FUNC_NAME
,
1140 "invalid inet address representation: ~A",
1141 scm_list_1 (address
));
1144 struct sockaddr_in c_inet
;
1146 c_inet
.sin_addr
.s_addr
=
1147 htonl (scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 1)));
1149 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1150 c_inet
.sin_family
= AF_INET
;
1152 *address_size
= sizeof (c_inet
);
1153 c_address
= scm_malloc (sizeof (c_inet
));
1154 memcpy (c_address
, &c_inet
, sizeof (c_inet
));
1163 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 5)
1164 scm_misc_error (FUNC_NAME
, "invalid inet6 address representation: ~A",
1165 scm_list_1 (address
));
1168 struct sockaddr_in6 c_inet6
;
1170 scm_to_ipv6 (c_inet6
.sin6_addr
.s6_addr
, address
);
1172 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1173 c_inet6
.sin6_flowinfo
=
1174 scm_to_uint32 (SCM_SIMPLE_VECTOR_REF (address
, 3));
1175 #ifdef HAVE_SIN6_SCOPE_ID
1176 c_inet6
.sin6_scope_id
=
1177 scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 4));
1180 c_inet6
.sin6_family
= AF_INET6
;
1182 *address_size
= sizeof (c_inet6
);
1183 c_address
= scm_malloc (sizeof (c_inet6
));
1184 memcpy (c_address
, &c_inet6
, sizeof (c_inet6
));
1191 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1194 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 2)
1195 scm_misc_error (FUNC_NAME
, "invalid unix address representation: ~A",
1196 scm_list_1 (address
));
1200 size_t path_len
= 0;
1202 path
= SCM_SIMPLE_VECTOR_REF (address
, 1);
1203 if ((!scm_is_string (path
)) && (path
!= SCM_BOOL_F
))
1204 scm_misc_error (FUNC_NAME
, "invalid unix address "
1205 "path: ~A", scm_list_1 (path
));
1208 struct sockaddr_un c_unix
;
1210 if (path
== SCM_BOOL_F
)
1213 path_len
= scm_c_string_length (path
);
1215 #ifdef UNIX_PATH_MAX
1216 if (path_len
>= UNIX_PATH_MAX
)
1218 /* We can hope that this limit will eventually vanish, at least on GNU.
1219 However, currently, while glibc doesn't define `UNIX_PATH_MAX', it
1220 documents it has being limited to 108 bytes. */
1221 if (path_len
>= sizeof (c_unix
.sun_path
))
1223 scm_misc_error (FUNC_NAME
, "unix address path "
1224 "too long: ~A", scm_list_1 (path
));
1229 scm_to_locale_stringbuf (path
, c_unix
.sun_path
,
1230 #ifdef UNIX_PATH_MAX
1233 sizeof (c_unix
.sun_path
));
1235 c_unix
.sun_path
[path_len
] = '\0';
1238 if (strlen (c_unix
.sun_path
) != path_len
)
1239 scm_misc_error (FUNC_NAME
, "unix address path "
1240 "contains nul characters: ~A",
1244 c_unix
.sun_path
[0] = '\0';
1246 c_unix
.sun_family
= AF_UNIX
;
1248 *address_size
= SUN_LEN (&c_unix
);
1249 c_address
= scm_malloc (sizeof (c_unix
));
1250 memcpy (c_address
, &c_unix
, sizeof (c_unix
));
1260 scm_misc_error (FUNC_NAME
, "unrecognised address family: ~A",
1261 scm_list_1 (scm_from_ushort (family
)));
1269 /* Return a newly-allocated `sockaddr' structure that reflects ADDRESS, being
1270 an address of family FAMILY, with the family-specific parameters ARGS (see
1271 the description of `connect' for details). The returned structure may be
1272 freed using `free ()'. */
1274 scm_c_make_socket_address (SCM family
, SCM address
, SCM args
,
1275 size_t *address_size
)
1277 struct sockaddr
*soka
;
1279 soka
= scm_fill_sockaddr (scm_to_ushort (family
), address
, &args
, 1,
1280 "scm_c_make_socket_address", address_size
);
1285 SCM_DEFINE (scm_make_socket_address
, "make-socket-address", 2, 0, 1,
1286 (SCM family
, SCM address
, SCM args
),
1287 "Return a Scheme address object that reflects @var{address}, "
1288 "being an address of family @var{family}, with the "
1289 "family-specific parameters @var{args} (see the description of "
1290 "@code{connect} for details).")
1291 #define FUNC_NAME s_scm_make_socket_address
1293 SCM result
= SCM_BOOL_F
;
1294 struct sockaddr
*c_address
;
1295 size_t c_address_size
;
1297 c_address
= scm_c_make_socket_address (family
, address
, args
,
1299 if (c_address
!= NULL
)
1301 result
= scm_from_sockaddr (c_address
, c_address_size
);
1310 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
1312 "Accept a connection on a bound, listening socket.\n"
1314 "are no pending connections in the queue, wait until\n"
1315 "one is available unless the non-blocking option has been\n"
1316 "set on the socket.\n\n"
1317 "The return value is a\n"
1318 "pair in which the @emph{car} is a new socket port for the\n"
1320 "the @emph{cdr} is an object with address information about the\n"
1321 "client which initiated the connection.\n\n"
1322 "@var{sock} does not become part of the\n"
1323 "connection and will continue to accept new requests.")
1324 #define FUNC_NAME s_scm_accept
1330 SELECT_TYPE readfds
, exceptfds
;
1331 socklen_t addr_size
= MAX_ADDR_SIZE
;
1332 scm_t_max_sockaddr addr
;
1334 sock
= SCM_COERCE_OUTPORT (sock
);
1335 SCM_VALIDATE_OPFPORT (1, sock
);
1336 fd
= SCM_FPORT_FDES (sock
);
1339 FD_ZERO (&exceptfds
);
1340 FD_SET (fd
, &readfds
);
1341 FD_SET (fd
, &exceptfds
);
1343 /* Block until something happens on FD, leaving guile mode while
1345 selected
= scm_std_select (fd
+ 1, &readfds
, NULL
, &exceptfds
,
1350 newfd
= accept (fd
, (struct sockaddr
*) &addr
, &addr_size
);
1353 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
1354 address
= _scm_from_sockaddr (&addr
, addr_size
,
1357 return scm_cons (newsock
, address
);
1361 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
1363 "Return the address of @var{sock}, in the same form as the\n"
1364 "object returned by @code{accept}. On many systems the address\n"
1365 "of a socket in the @code{AF_FILE} namespace cannot be read.")
1366 #define FUNC_NAME s_scm_getsockname
1369 socklen_t addr_size
= MAX_ADDR_SIZE
;
1370 scm_t_max_sockaddr addr
;
1372 sock
= SCM_COERCE_OUTPORT (sock
);
1373 SCM_VALIDATE_OPFPORT (1, sock
);
1374 fd
= SCM_FPORT_FDES (sock
);
1375 if (getsockname (fd
, (struct sockaddr
*) &addr
, &addr_size
) == -1)
1378 return _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1382 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
1384 "Return the address that @var{sock}\n"
1385 "is connected to, in the same form as the object returned by\n"
1386 "@code{accept}. On many systems the address of a socket in the\n"
1387 "@code{AF_FILE} namespace cannot be read.")
1388 #define FUNC_NAME s_scm_getpeername
1391 socklen_t addr_size
= MAX_ADDR_SIZE
;
1392 scm_t_max_sockaddr addr
;
1394 sock
= SCM_COERCE_OUTPORT (sock
);
1395 SCM_VALIDATE_OPFPORT (1, sock
);
1396 fd
= SCM_FPORT_FDES (sock
);
1397 if (getpeername (fd
, (struct sockaddr
*) &addr
, &addr_size
) == -1)
1400 return _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1404 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
1405 (SCM sock
, SCM buf
, SCM flags
),
1406 "Receive data from a socket port.\n"
1407 "@var{sock} must already\n"
1408 "be bound to the address from which data is to be received.\n"
1409 "@var{buf} is a string into which\n"
1410 "the data will be written. The size of @var{buf} limits\n"
1412 "data which can be received: in the case of packet\n"
1413 "protocols, if a packet larger than this limit is encountered\n"
1415 "will be irrevocably lost.\n\n"
1416 "The optional @var{flags} argument is a value or\n"
1417 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1418 "The value returned is the number of bytes read from the\n"
1420 "Note that the data is read directly from the socket file\n"
1422 "any unread buffered port data is ignored.")
1423 #define FUNC_NAME s_scm_recv
1431 SCM_VALIDATE_OPFPORT (1, sock
);
1432 SCM_VALIDATE_STRING (2, buf
);
1433 if (SCM_UNBNDP (flags
))
1436 flg
= scm_to_int (flags
);
1437 fd
= SCM_FPORT_FDES (sock
);
1439 len
= scm_i_string_length (buf
);
1440 dest
= scm_i_string_writable_chars (buf
);
1441 SCM_SYSCALL (rv
= recv (fd
, dest
, len
, flg
));
1442 scm_i_string_stop_writing ();
1447 scm_remember_upto_here_1 (buf
);
1448 return scm_from_int (rv
);
1452 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
1453 (SCM sock
, SCM message
, SCM flags
),
1454 "Transmit the string @var{message} on a socket port @var{sock}.\n"
1455 "@var{sock} must already be bound to a destination address. The\n"
1456 "value returned is the number of bytes transmitted --\n"
1457 "it's possible for\n"
1458 "this to be less than the length of @var{message}\n"
1459 "if the socket is\n"
1460 "set to be non-blocking. The optional @var{flags} argument\n"
1462 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1463 "Note that the data is written directly to the socket\n"
1464 "file descriptor:\n"
1465 "any unflushed buffered port data is ignored.")
1466 #define FUNC_NAME s_scm_send
1474 sock
= SCM_COERCE_OUTPORT (sock
);
1475 SCM_VALIDATE_OPFPORT (1, sock
);
1476 SCM_VALIDATE_STRING (2, message
);
1477 if (SCM_UNBNDP (flags
))
1480 flg
= scm_to_int (flags
);
1481 fd
= SCM_FPORT_FDES (sock
);
1483 len
= scm_i_string_length (message
);
1484 src
= scm_i_string_writable_chars (message
);
1485 SCM_SYSCALL (rv
= send (fd
, src
, len
, flg
));
1486 scm_i_string_stop_writing ();
1491 scm_remember_upto_here_1 (message
);
1492 return scm_from_int (rv
);
1496 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
1497 (SCM sock
, SCM str
, SCM flags
, SCM start
, SCM end
),
1498 "Receive data from socket port @var{sock} (which must be already\n"
1499 "bound), returning the originating address as well as the data.\n"
1500 "This is usually for use on datagram sockets, but can be used on\n"
1501 "stream-oriented sockets too.\n"
1503 "The data received is stored in the given @var{str}, using\n"
1504 "either the whole string or just the region between the optional\n"
1505 "@var{start} and @var{end} positions. The size of @var{str}\n"
1506 "limits the amount of data which can be received. For datagram\n"
1507 "protocols, if a packet larger than this is received then excess\n"
1508 "bytes are irrevocably lost.\n"
1510 "The return value is a pair. The @code{car} is the number of\n"
1511 "bytes read. The @code{cdr} is a socket address object which is\n"
1512 "where the data come from, or @code{#f} if the origin is\n"
1515 "The optional @var{flags} argument is a or bitwise OR\n"
1516 "(@code{logior}) of @code{MSG_OOB}, @code{MSG_PEEK},\n"
1517 "@code{MSG_DONTROUTE} etc.\n"
1519 "Data is read directly from the socket file descriptor, any\n"
1520 "buffered port data is ignored.\n"
1522 "On a GNU/Linux system @code{recvfrom!} is not multi-threading,\n"
1523 "all threads stop while a @code{recvfrom!} call is in progress.\n"
1524 "An application may need to use @code{select}, @code{O_NONBLOCK}\n"
1525 "or @code{MSG_DONTWAIT} to avoid this.")
1526 #define FUNC_NAME s_scm_recvfrom
1535 socklen_t addr_size
= MAX_ADDR_SIZE
;
1536 scm_t_max_sockaddr addr
;
1538 SCM_VALIDATE_OPFPORT (1, sock
);
1539 fd
= SCM_FPORT_FDES (sock
);
1541 SCM_VALIDATE_STRING (2, str
);
1542 scm_i_get_substring_spec (scm_i_string_length (str
),
1543 start
, &offset
, end
, &cend
);
1545 if (SCM_UNBNDP (flags
))
1548 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
1550 /* recvfrom will not necessarily return an address. usually nothing
1551 is returned for stream sockets. */
1552 buf
= scm_i_string_writable_chars (str
);
1553 ((struct sockaddr
*) &addr
)->sa_family
= AF_UNSPEC
;
1554 SCM_SYSCALL (rv
= recvfrom (fd
, buf
+ offset
,
1556 (struct sockaddr
*) &addr
, &addr_size
));
1557 scm_i_string_stop_writing ();
1561 if (((struct sockaddr
*) &addr
)->sa_family
!= AF_UNSPEC
)
1562 address
= _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1564 address
= SCM_BOOL_F
;
1566 scm_remember_upto_here_1 (str
);
1568 return scm_cons (scm_from_int (rv
), address
);
1572 SCM_DEFINE (scm_sendto
, "sendto", 3, 1, 1,
1573 (SCM sock
, SCM message
, SCM fam_or_sockaddr
, SCM address
, SCM args_and_flags
),
1574 "Transmit the string @var{message} on the socket port\n"
1576 "destination address is specified using the @var{fam},\n"
1577 "@var{address} and\n"
1578 "@var{args_and_flags} arguments, or just a socket address object "
1579 "returned by @code{make-socket-address}, in a similar way to the\n"
1580 "@code{connect} procedure. @var{args_and_flags} contains\n"
1581 "the usual connection arguments optionally followed by\n"
1582 "a flags argument, which is a value or\n"
1583 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1584 "The value returned is the number of bytes transmitted --\n"
1585 "it's possible for\n"
1586 "this to be less than the length of @var{message} if the\n"
1588 "set to be non-blocking.\n"
1589 "Note that the data is written directly to the socket\n"
1590 "file descriptor:\n"
1591 "any unflushed buffered port data is ignored.")
1592 #define FUNC_NAME s_scm_sendto
1597 struct sockaddr
*soka
;
1600 sock
= SCM_COERCE_OUTPORT (sock
);
1601 SCM_VALIDATE_FPORT (1, sock
);
1602 SCM_VALIDATE_STRING (2, message
);
1603 fd
= SCM_FPORT_FDES (sock
);
1605 if (!scm_is_number (fam_or_sockaddr
))
1607 /* FAM_OR_SOCKADDR must actually be a `socket address' object. This
1608 means that the following arguments, i.e. ADDRESS and those listed in
1609 ARGS_AND_FLAGS, are the `MSG_' flags. */
1610 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
1611 if (address
!= SCM_UNDEFINED
)
1612 args_and_flags
= scm_cons (address
, args_and_flags
);
1615 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
1616 &args_and_flags
, 3, FUNC_NAME
, &size
);
1618 if (scm_is_null (args_and_flags
))
1622 SCM_VALIDATE_CONS (5, args_and_flags
);
1623 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
1625 SCM_SYSCALL (rv
= sendto (fd
,
1626 scm_i_string_chars (message
),
1627 scm_i_string_length (message
),
1631 int save_errno
= errno
;
1638 scm_remember_upto_here_1 (message
);
1639 return scm_from_int (rv
);
1648 /* protocol families. */
1650 scm_c_define ("AF_UNSPEC", scm_from_int (AF_UNSPEC
));
1653 scm_c_define ("AF_UNIX", scm_from_int (AF_UNIX
));
1656 scm_c_define ("AF_INET", scm_from_int (AF_INET
));
1659 scm_c_define ("AF_INET6", scm_from_int (AF_INET6
));
1663 scm_c_define ("PF_UNSPEC", scm_from_int (PF_UNSPEC
));
1666 scm_c_define ("PF_UNIX", scm_from_int (PF_UNIX
));
1669 scm_c_define ("PF_INET", scm_from_int (PF_INET
));
1672 scm_c_define ("PF_INET6", scm_from_int (PF_INET6
));
1675 /* standard addresses. */
1677 scm_c_define ("INADDR_ANY", scm_from_ulong (INADDR_ANY
));
1679 #ifdef INADDR_BROADCAST
1680 scm_c_define ("INADDR_BROADCAST", scm_from_ulong (INADDR_BROADCAST
));
1683 scm_c_define ("INADDR_NONE", scm_from_ulong (INADDR_NONE
));
1685 #ifdef INADDR_LOOPBACK
1686 scm_c_define ("INADDR_LOOPBACK", scm_from_ulong (INADDR_LOOPBACK
));
1691 SOCK_PACKET is deliberately omitted, the GNU/Linux socket(2) and
1692 packet(7) advise that it's obsolete and strongly deprecated. */
1695 scm_c_define ("SOCK_STREAM", scm_from_int (SOCK_STREAM
));
1698 scm_c_define ("SOCK_DGRAM", scm_from_int (SOCK_DGRAM
));
1700 #ifdef SOCK_SEQPACKET
1701 scm_c_define ("SOCK_SEQPACKET", scm_from_int (SOCK_SEQPACKET
));
1704 scm_c_define ("SOCK_RAW", scm_from_int (SOCK_RAW
));
1707 scm_c_define ("SOCK_RDM", scm_from_int (SOCK_RDM
));
1710 /* setsockopt level.
1712 SOL_IP, SOL_TCP and SOL_UDP are defined on gnu/linux, but not on for
1713 instance NetBSD. We define IPPROTOs because that's what the posix spec
1714 shows in its example at
1716 http://www.opengroup.org/onlinepubs/007904975/functions/getsockopt.html
1719 scm_c_define ("SOL_SOCKET", scm_from_int (SOL_SOCKET
));
1722 scm_c_define ("IPPROTO_IP", scm_from_int (IPPROTO_IP
));
1725 scm_c_define ("IPPROTO_TCP", scm_from_int (IPPROTO_TCP
));
1728 scm_c_define ("IPPROTO_UDP", scm_from_int (IPPROTO_UDP
));
1731 /* setsockopt names. */
1733 scm_c_define ("SO_DEBUG", scm_from_int (SO_DEBUG
));
1736 scm_c_define ("SO_REUSEADDR", scm_from_int (SO_REUSEADDR
));
1739 scm_c_define ("SO_STYLE", scm_from_int (SO_STYLE
));
1742 scm_c_define ("SO_TYPE", scm_from_int (SO_TYPE
));
1745 scm_c_define ("SO_ERROR", scm_from_int (SO_ERROR
));
1748 scm_c_define ("SO_DONTROUTE", scm_from_int (SO_DONTROUTE
));
1751 scm_c_define ("SO_BROADCAST", scm_from_int (SO_BROADCAST
));
1754 scm_c_define ("SO_SNDBUF", scm_from_int (SO_SNDBUF
));
1757 scm_c_define ("SO_RCVBUF", scm_from_int (SO_RCVBUF
));
1760 scm_c_define ("SO_KEEPALIVE", scm_from_int (SO_KEEPALIVE
));
1763 scm_c_define ("SO_OOBINLINE", scm_from_int (SO_OOBINLINE
));
1766 scm_c_define ("SO_NO_CHECK", scm_from_int (SO_NO_CHECK
));
1769 scm_c_define ("SO_PRIORITY", scm_from_int (SO_PRIORITY
));
1772 scm_c_define ("SO_LINGER", scm_from_int (SO_LINGER
));
1775 /* recv/send options. */
1777 scm_c_define ("MSG_DONTWAIT", scm_from_int (MSG_DONTWAIT
));
1780 scm_c_define ("MSG_OOB", scm_from_int (MSG_OOB
));
1783 scm_c_define ("MSG_PEEK", scm_from_int (MSG_PEEK
));
1785 #ifdef MSG_DONTROUTE
1786 scm_c_define ("MSG_DONTROUTE", scm_from_int (MSG_DONTROUTE
));
1790 scm_i_init_socket_Win32 ();
1793 #ifdef IP_ADD_MEMBERSHIP
1794 scm_c_define ("IP_ADD_MEMBERSHIP", scm_from_int (IP_ADD_MEMBERSHIP
));
1795 scm_c_define ("IP_DROP_MEMBERSHIP", scm_from_int (IP_DROP_MEMBERSHIP
));
1798 scm_add_feature ("socket");
1800 #include "libguile/socket.x"