1 /* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 2009 Free Software Foundation, Inc.
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public License
5 * as published by the Free Software Foundation; either version 3 of
6 * the License, or (at your option) any later version.
8 * This library is distributed in the hope that it will be useful, but
9 * WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
29 #include "libguile/_scm.h"
30 #include "libguile/arrays.h"
31 #include "libguile/feature.h"
32 #include "libguile/fports.h"
33 #include "libguile/strings.h"
34 #include "libguile/vectors.h"
35 #include "libguile/dynwind.h"
36 #include "libguile/srfi-13.h"
38 #include "libguile/validate.h"
39 #include "libguile/socket.h"
41 #include "libguile/iselect.h"
44 #include "win32-socket.h"
56 #include <sys/types.h>
57 #ifdef HAVE_WINSOCK2_H
60 #include <sys/socket.h>
61 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
64 #include <netinet/in.h>
66 #include <arpa/inet.h>
69 #if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
70 #define SUN_LEN(ptr) ((size_t) (((struct sockaddr_un *) 0)->sun_path) \
71 + strlen ((ptr)->sun_path))
74 /* The largest possible socket address. Wrapping it in a union guarantees
75 that the compiler will make it suitably aligned. */
78 struct sockaddr sockaddr
;
79 struct sockaddr_in sockaddr_in
;
81 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
82 struct sockaddr_un sockaddr_un
;
85 struct sockaddr_in6 sockaddr_in6
;
90 /* Maximum size of a socket address. */
91 #define MAX_ADDR_SIZE (sizeof (scm_t_max_sockaddr))
96 SCM_DEFINE (scm_htons
, "htons", 1, 0, 0,
98 "Convert a 16 bit quantity from host to network byte ordering.\n"
99 "@var{value} is packed into 2 bytes, which are then converted\n"
100 "and returned as a new integer.")
101 #define FUNC_NAME s_scm_htons
103 return scm_from_ushort (htons (scm_to_ushort (value
)));
107 SCM_DEFINE (scm_ntohs
, "ntohs", 1, 0, 0,
109 "Convert a 16 bit quantity from network to host byte ordering.\n"
110 "@var{value} is packed into 2 bytes, which are then converted\n"
111 "and returned as a new integer.")
112 #define FUNC_NAME s_scm_ntohs
114 return scm_from_ushort (ntohs (scm_to_ushort (value
)));
118 SCM_DEFINE (scm_htonl
, "htonl", 1, 0, 0,
120 "Convert a 32 bit quantity from host to network byte ordering.\n"
121 "@var{value} is packed into 4 bytes, which are then converted\n"
122 "and returned as a new integer.")
123 #define FUNC_NAME s_scm_htonl
125 return scm_from_ulong (htonl (scm_to_uint32 (value
)));
129 SCM_DEFINE (scm_ntohl
, "ntohl", 1, 0, 0,
131 "Convert a 32 bit quantity from network to host byte ordering.\n"
132 "@var{value} is packed into 4 bytes, which are then converted\n"
133 "and returned as a new integer.")
134 #define FUNC_NAME s_scm_ntohl
136 return scm_from_ulong (ntohl (scm_to_uint32 (value
)));
140 #ifndef HAVE_INET_ATON
141 /* for our definition in inet_aton.c, not usually needed. */
142 extern int inet_aton ();
145 SCM_DEFINE (scm_inet_aton
, "inet-aton", 1, 0, 0,
147 "Convert an IPv4 Internet address from printable string\n"
148 "(dotted decimal notation) to an integer. E.g.,\n\n"
150 "(inet-aton \"127.0.0.1\") @result{} 2130706433\n"
152 #define FUNC_NAME s_scm_inet_aton
158 c_address
= scm_to_locale_string (address
);
159 rv
= inet_aton (c_address
, &soka
);
162 SCM_MISC_ERROR ("bad address", SCM_EOL
);
163 return scm_from_ulong (ntohl (soka
.s_addr
));
168 SCM_DEFINE (scm_inet_ntoa
, "inet-ntoa", 1, 0, 0,
170 "Convert an IPv4 Internet address to a printable\n"
171 "(dotted decimal notation) string. E.g.,\n\n"
173 "(inet-ntoa 2130706433) @result{} \"127.0.0.1\"\n"
175 #define FUNC_NAME s_scm_inet_ntoa
180 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, inetid
));
181 s
= inet_ntoa (addr
);
182 answer
= scm_from_locale_string (s
);
187 #ifdef HAVE_INET_NETOF
188 SCM_DEFINE (scm_inet_netof
, "inet-netof", 1, 0, 0,
190 "Return the network number part of the given IPv4\n"
191 "Internet address. E.g.,\n\n"
193 "(inet-netof 2130706433) @result{} 127\n"
195 #define FUNC_NAME s_scm_inet_netof
198 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
199 return scm_from_ulong (inet_netof (addr
));
204 #ifdef HAVE_INET_LNAOF
205 SCM_DEFINE (scm_lnaof
, "inet-lnaof", 1, 0, 0,
207 "Return the local-address-with-network part of the given\n"
208 "IPv4 Internet address, using the obsolete class A/B/C system.\n"
211 "(inet-lnaof 2130706433) @result{} 1\n"
213 #define FUNC_NAME s_scm_lnaof
216 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
217 return scm_from_ulong (inet_lnaof (addr
));
222 #ifdef HAVE_INET_MAKEADDR
223 SCM_DEFINE (scm_inet_makeaddr
, "inet-makeaddr", 2, 0, 0,
225 "Make an IPv4 Internet address by combining the network number\n"
226 "@var{net} with the local-address-within-network number\n"
227 "@var{lna}. E.g.,\n\n"
229 "(inet-makeaddr 127 1) @result{} 2130706433\n"
231 #define FUNC_NAME s_scm_inet_makeaddr
234 unsigned long netnum
;
235 unsigned long lnanum
;
237 netnum
= SCM_NUM2ULONG (1, net
);
238 lnanum
= SCM_NUM2ULONG (2, lna
);
239 addr
= inet_makeaddr (netnum
, lnanum
);
240 return scm_from_ulong (ntohl (addr
.s_addr
));
247 /* flip a 128 bit IPv6 address between host and network order. */
248 #ifdef WORDS_BIGENDIAN
249 #define FLIP_NET_HOST_128(addr)
251 #define FLIP_NET_HOST_128(addr)\
255 for (i = 0; i < 8; i++)\
257 scm_t_uint8 c = (addr)[i];\
259 (addr)[i] = (addr)[15 - i];\
265 #ifdef WORDS_BIGENDIAN
266 #define FLIPCPY_NET_HOST_128(dest, src) memcpy (dest, src, 16)
268 #define FLIPCPY_NET_HOST_128(dest, src) \
270 const scm_t_uint8 *tmp_srcp = (src) + 15; \
271 scm_t_uint8 *tmp_destp = (dest); \
274 *tmp_destp++ = *tmp_srcp--; \
275 } while (tmp_srcp != (src)); \
280 #if (SIZEOF_SCM_T_BITS * SCM_CHAR_BIT) > 128
281 #error "Assumption that scm_t_bits <= 128 bits has been violated."
284 #if (SIZEOF_UNSIGNED_LONG * SCM_CHAR_BIT) > 128
285 #error "Assumption that unsigned long <= 128 bits has been violated."
288 #if (SIZEOF_UNSIGNED_LONG_LONG * SCM_CHAR_BIT) > 128
289 #error "Assumption that unsigned long long <= 128 bits has been violated."
292 /* convert a 128 bit IPv6 address in network order to a host ordered
295 scm_from_ipv6 (const scm_t_uint8
*src
)
297 SCM result
= scm_i_mkbig ();
298 mpz_import (SCM_I_BIG_MPZ (result
),
300 1, /* big-endian chunk ordering */
301 16, /* chunks are 16 bytes long */
302 1, /* big-endian byte ordering */
303 0, /* "nails" -- leading unused bits per chunk */
305 return scm_i_normbig (result
);
308 /* convert a host ordered SCM integer to a 128 bit IPv6 address in
311 scm_to_ipv6 (scm_t_uint8 dst
[16], SCM src
)
313 if (SCM_I_INUMP (src
))
315 scm_t_signed_bits n
= SCM_I_INUM (src
);
317 scm_out_of_range (NULL
, src
);
318 #ifdef WORDS_BIGENDIAN
319 memset (dst
, 0, 16 - sizeof (scm_t_signed_bits
));
320 memcpy (dst
+ (16 - sizeof (scm_t_signed_bits
)),
322 sizeof (scm_t_signed_bits
));
324 memset (dst
+ sizeof (scm_t_signed_bits
),
326 16 - sizeof (scm_t_signed_bits
));
327 /* FIXME: this pair of ops is kinda wasteful -- should rewrite as
328 a single loop perhaps, similar to the handling of bignums. */
329 memcpy (dst
, &n
, sizeof (scm_t_signed_bits
));
330 FLIP_NET_HOST_128 (dst
);
333 else if (SCM_BIGP (src
))
337 if ((mpz_sgn (SCM_I_BIG_MPZ (src
)) < 0)
338 || mpz_sizeinbase (SCM_I_BIG_MPZ (src
), 2) > 128)
339 scm_out_of_range (NULL
, src
);
344 1, /* big-endian chunk ordering */
345 16, /* chunks are 16 bytes long */
346 1, /* big-endian byte ordering */
347 0, /* "nails" -- leading unused bits per chunk */
348 SCM_I_BIG_MPZ (src
));
349 scm_remember_upto_here_1 (src
);
352 scm_wrong_type_arg_msg ("scm_to_ipv6", 0, src
, "integer");
355 #ifdef HAVE_INET_PTON
356 SCM_DEFINE (scm_inet_pton
, "inet-pton", 2, 0, 0,
357 (SCM family
, SCM address
),
358 "Convert a string containing a printable network address to\n"
359 "an integer address. Note that unlike the C version of this\n"
361 "the result is an integer with normal host byte ordering.\n"
362 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
364 "(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
365 "(inet-pton AF_INET6 \"::1\") @result{} 1\n"
367 #define FUNC_NAME s_scm_inet_pton
374 af
= scm_to_int (family
);
375 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
376 src
= scm_to_locale_string (address
);
377 rv
= inet_pton (af
, src
, dst
);
384 SCM_MISC_ERROR ("Bad address", SCM_EOL
);
386 return scm_from_ulong (ntohl (*dst
));
388 return scm_from_ipv6 ((scm_t_uint8
*) dst
);
393 #ifdef HAVE_INET_NTOP
394 SCM_DEFINE (scm_inet_ntop
, "inet-ntop", 2, 0, 0,
395 (SCM family
, SCM address
),
396 "Convert a network address into a printable string.\n"
397 "Note that unlike the C version of this function,\n"
398 "the input is an integer with normal host byte ordering.\n"
399 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
401 "(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
402 "(inet-ntop AF_INET6 (- (expt 2 128) 1))\n"
403 " @result{} \"ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\"\n"
405 #define FUNC_NAME s_scm_inet_ntop
408 #ifdef INET6_ADDRSTRLEN
409 char dst
[INET6_ADDRSTRLEN
];
415 af
= scm_to_int (family
);
416 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
421 addr4
= htonl (SCM_NUM2ULONG (2, address
));
422 result
= inet_ntop (af
, &addr4
, dst
, sizeof (dst
));
428 scm_to_ipv6 ((scm_t_uint8
*) addr6
, address
);
429 result
= inet_ntop (af
, &addr6
, dst
, sizeof (dst
));
435 return scm_from_locale_string (dst
);
440 #endif /* HAVE_IPV6 */
442 SCM_SYMBOL (sym_socket
, "socket");
444 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
446 SCM_DEFINE (scm_socket
, "socket", 3, 0, 0,
447 (SCM family
, SCM style
, SCM proto
),
448 "Return a new socket port of the type specified by @var{family},\n"
449 "@var{style} and @var{proto}. All three parameters are\n"
450 "integers. Supported values for @var{family} are\n"
451 "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
452 "Typical values for @var{style} are @code{SOCK_STREAM},\n"
453 "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
454 "@var{proto} can be obtained from a protocol name using\n"
455 "@code{getprotobyname}. A value of zero specifies the default\n"
456 "protocol, which is usually right.\n\n"
457 "A single socket port cannot by used for communication until it\n"
458 "has been connected to another socket.")
459 #define FUNC_NAME s_scm_socket
463 fd
= socket (scm_to_int (family
),
468 return SCM_SOCK_FD_TO_PORT (fd
);
472 #ifdef HAVE_SOCKETPAIR
473 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
474 (SCM family
, SCM style
, SCM proto
),
475 "Return a pair of connected (but unnamed) socket ports of the\n"
476 "type specified by @var{family}, @var{style} and @var{proto}.\n"
477 "Many systems support only socket pairs of the @code{AF_UNIX}\n"
478 "family. Zero is likely to be the only meaningful value for\n"
480 #define FUNC_NAME s_scm_socketpair
485 fam
= scm_to_int (family
);
487 if (socketpair (fam
, scm_to_int (style
), scm_to_int (proto
), fd
) == -1)
490 return scm_cons (SCM_SOCK_FD_TO_PORT (fd
[0]), SCM_SOCK_FD_TO_PORT (fd
[1]));
495 /* Possible results for `getsockopt ()'. Wrapping it into a union guarantees
496 suitable alignment. */
499 #ifdef HAVE_STRUCT_LINGER
500 struct linger linger
;
504 } scm_t_getsockopt_result
;
506 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
507 (SCM sock
, SCM level
, SCM optname
),
508 "Return an option value from socket port @var{sock}.\n"
510 "@var{level} is an integer specifying a protocol layer, either\n"
511 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
512 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
513 "(@pxref{Network Databases}).\n"
515 "@defvar SOL_SOCKET\n"
516 "@defvarx IPPROTO_IP\n"
517 "@defvarx IPPROTO_TCP\n"
518 "@defvarx IPPROTO_UDP\n"
521 "@var{optname} is an integer specifying an option within the\n"
524 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
525 "defined (when provided by the system). For their meaning see\n"
526 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
527 "Manual}, or @command{man 7 socket}.\n"
530 "@defvarx SO_REUSEADDR\n"
531 "@defvarx SO_STYLE\n"
533 "@defvarx SO_ERROR\n"
534 "@defvarx SO_DONTROUTE\n"
535 "@defvarx SO_BROADCAST\n"
536 "@defvarx SO_SNDBUF\n"
537 "@defvarx SO_RCVBUF\n"
538 "@defvarx SO_KEEPALIVE\n"
539 "@defvarx SO_OOBINLINE\n"
540 "@defvarx SO_NO_CHECK\n"
541 "@defvarx SO_PRIORITY\n"
542 "The value returned is an integer.\n"
545 "@defvar SO_LINGER\n"
546 "The @var{value} returned is a pair of integers\n"
547 "@code{(@var{ENABLE} . @var{TIMEOUT})}. On old systems without\n"
548 "timeout support (ie.@: without @code{struct linger}), only\n"
549 "@var{ENABLE} has an effect but the value in Guile is always a\n"
552 #define FUNC_NAME s_scm_getsockopt
555 /* size of optval is the largest supported option. */
556 scm_t_getsockopt_result optval
;
557 socklen_t optlen
= sizeof (optval
);
561 sock
= SCM_COERCE_OUTPORT (sock
);
562 SCM_VALIDATE_OPFPORT (1, sock
);
563 ilevel
= scm_to_int (level
);
564 ioptname
= scm_to_int (optname
);
566 fd
= SCM_FPORT_FDES (sock
);
567 if (getsockopt (fd
, ilevel
, ioptname
, (void *) &optval
, &optlen
) == -1)
570 if (ilevel
== SOL_SOCKET
)
573 if (ioptname
== SO_LINGER
)
575 #ifdef HAVE_STRUCT_LINGER
576 struct linger
*ling
= (struct linger
*) &optval
;
578 return scm_cons (scm_from_long (ling
->l_onoff
),
579 scm_from_long (ling
->l_linger
));
581 return scm_cons (scm_from_long (*(int *) &optval
),
589 || ioptname
== SO_SNDBUF
592 || ioptname
== SO_RCVBUF
596 return scm_from_size_t (*(size_t *) &optval
);
599 return scm_from_int (*(int *) &optval
);
603 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
604 (SCM sock
, SCM level
, SCM optname
, SCM value
),
605 "Set an option on socket port @var{sock}. The return value is\n"
608 "@var{level} is an integer specifying a protocol layer, either\n"
609 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
610 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
611 "(@pxref{Network Databases}).\n"
613 "@defvar SOL_SOCKET\n"
614 "@defvarx IPPROTO_IP\n"
615 "@defvarx IPPROTO_TCP\n"
616 "@defvarx IPPROTO_UDP\n"
619 "@var{optname} is an integer specifying an option within the\n"
622 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
623 "defined (when provided by the system). For their meaning see\n"
624 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
625 "Manual}, or @command{man 7 socket}.\n"
628 "@defvarx SO_REUSEADDR\n"
629 "@defvarx SO_STYLE\n"
631 "@defvarx SO_ERROR\n"
632 "@defvarx SO_DONTROUTE\n"
633 "@defvarx SO_BROADCAST\n"
634 "@defvarx SO_SNDBUF\n"
635 "@defvarx SO_RCVBUF\n"
636 "@defvarx SO_KEEPALIVE\n"
637 "@defvarx SO_OOBINLINE\n"
638 "@defvarx SO_NO_CHECK\n"
639 "@defvarx SO_PRIORITY\n"
640 "@var{value} is an integer.\n"
643 "@defvar SO_LINGER\n"
644 "@var{value} is a pair of integers @code{(@var{ENABLE}\n"
645 ". @var{TIMEOUT})}. On old systems without timeout support\n"
646 "(ie.@: without @code{struct linger}), only @var{ENABLE} has an\n"
647 "effect but the value in Guile is always a pair.\n"
650 "@c Note that we refer only to ``man ip'' here. On GNU/Linux it's\n"
651 "@c ``man 7 ip'' but on NetBSD it's ``man 4 ip''.\n"
653 "For IP level (@code{IPPROTO_IP}) the following @var{optname}s\n"
654 "are defined (when provided by the system). See @command{man\n"
655 "ip} for what they mean.\n"
657 "@defvar IP_ADD_MEMBERSHIP\n"
658 "@defvarx IP_DROP_MEMBERSHIP\n"
659 "These can be used only with @code{setsockopt}, not\n"
660 "@code{getsockopt}. @var{value} is a pair\n"
661 "@code{(@var{MULTIADDR} . @var{INTERFACEADDR})} of IPv4\n"
662 "addresses (@pxref{Network Address Conversion}).\n"
663 "@var{MULTIADDR} is a multicast address to be added to or\n"
664 "dropped from the interface @var{INTERFACEADDR}.\n"
665 "@var{INTERFACEADDR} can be @code{INADDR_ANY} to have the system\n"
666 "select the interface. @var{INTERFACEADDR} can also be an\n"
667 "interface index number, on systems supporting that.\n"
669 #define FUNC_NAME s_scm_setsockopt
674 #ifdef HAVE_STRUCT_LINGER
675 struct linger opt_linger
;
678 #if HAVE_STRUCT_IP_MREQ
679 struct ip_mreq opt_mreq
;
682 const void *optval
= NULL
;
683 socklen_t optlen
= 0;
685 int ilevel
, ioptname
;
687 sock
= SCM_COERCE_OUTPORT (sock
);
689 SCM_VALIDATE_OPFPORT (1, sock
);
690 ilevel
= scm_to_int (level
);
691 ioptname
= scm_to_int (optname
);
693 fd
= SCM_FPORT_FDES (sock
);
695 if (ilevel
== SOL_SOCKET
)
698 if (ioptname
== SO_LINGER
)
700 #ifdef HAVE_STRUCT_LINGER
701 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
702 opt_linger
.l_onoff
= scm_to_int (SCM_CAR (value
));
703 opt_linger
.l_linger
= scm_to_int (SCM_CDR (value
));
704 optlen
= sizeof (struct linger
);
705 optval
= &opt_linger
;
707 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
708 opt_int
= scm_to_int (SCM_CAR (value
));
709 /* timeout is ignored, but may as well validate it. */
710 scm_to_int (SCM_CDR (value
));
711 optlen
= sizeof (int);
719 || ioptname
== SO_SNDBUF
722 || ioptname
== SO_RCVBUF
726 opt_int
= scm_to_int (value
);
727 optlen
= sizeof (size_t);
732 #if HAVE_STRUCT_IP_MREQ
733 if (ilevel
== IPPROTO_IP
&&
734 (ioptname
== IP_ADD_MEMBERSHIP
|| ioptname
== IP_DROP_MEMBERSHIP
))
736 /* Fourth argument must be a pair of addresses. */
737 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
738 opt_mreq
.imr_multiaddr
.s_addr
= htonl (scm_to_ulong (SCM_CAR (value
)));
739 opt_mreq
.imr_interface
.s_addr
= htonl (scm_to_ulong (SCM_CDR (value
)));
740 optlen
= sizeof (opt_mreq
);
747 /* Most options take an int. */
748 opt_int
= scm_to_int (value
);
749 optlen
= sizeof (int);
753 if (setsockopt (fd
, ilevel
, ioptname
, optval
, optlen
) == -1)
755 return SCM_UNSPECIFIED
;
759 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
761 "Sockets can be closed simply by using @code{close-port}. The\n"
762 "@code{shutdown} procedure allows reception or transmission on a\n"
763 "connection to be shut down individually, according to the parameter\n"
767 "Stop receiving data for this socket. If further data arrives, reject it.\n"
769 "Stop trying to transmit data from this socket. Discard any\n"
770 "data waiting to be sent. Stop looking for acknowledgement of\n"
771 "data already sent; don't retransmit it if it is lost.\n"
773 "Stop both reception and transmission.\n"
775 "The return value is unspecified.")
776 #define FUNC_NAME s_scm_shutdown
779 sock
= SCM_COERCE_OUTPORT (sock
);
780 SCM_VALIDATE_OPFPORT (1, sock
);
781 fd
= SCM_FPORT_FDES (sock
);
782 if (shutdown (fd
, scm_to_signed_integer (how
, 0, 2)) == -1)
784 return SCM_UNSPECIFIED
;
788 /* convert fam/address/args into a sockaddr of the appropriate type.
789 args is modified by removing the arguments actually used.
790 which_arg and proc are used when reporting errors:
791 which_arg is the position of address in the original argument list.
792 proc is the name of the original procedure.
793 size returns the size of the structure allocated. */
795 static struct sockaddr
*
796 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
797 const char *proc
, size_t *size
)
798 #define FUNC_NAME proc
804 struct sockaddr_in
*soka
;
808 SCM_VALIDATE_ULONG_COPY (which_arg
, address
, addr
);
809 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
810 port
= scm_to_int (SCM_CAR (*args
));
811 *args
= SCM_CDR (*args
);
812 soka
= (struct sockaddr_in
*) scm_malloc (sizeof (struct sockaddr_in
));
814 #if HAVE_STRUCT_SOCKADDR_SIN_LEN
815 soka
->sin_len
= sizeof (struct sockaddr_in
);
817 soka
->sin_family
= AF_INET
;
818 soka
->sin_addr
.s_addr
= htonl (addr
);
819 soka
->sin_port
= htons (port
);
820 *size
= sizeof (struct sockaddr_in
);
821 return (struct sockaddr
*) soka
;
828 struct sockaddr_in6
*soka
;
829 unsigned long flowinfo
= 0;
830 unsigned long scope_id
= 0;
832 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
833 port
= scm_to_int (SCM_CAR (*args
));
834 *args
= SCM_CDR (*args
);
835 if (scm_is_pair (*args
))
837 SCM_VALIDATE_ULONG_COPY (which_arg
+ 2, SCM_CAR (*args
), flowinfo
);
838 *args
= SCM_CDR (*args
);
839 if (scm_is_pair (*args
))
841 SCM_VALIDATE_ULONG_COPY (which_arg
+ 3, SCM_CAR (*args
),
843 *args
= SCM_CDR (*args
);
846 soka
= (struct sockaddr_in6
*) scm_malloc (sizeof (struct sockaddr_in6
));
848 #if HAVE_STRUCT_SOCKADDR_IN6_SIN6_LEN
849 soka
->sin6_len
= sizeof (struct sockaddr_in6
);
851 soka
->sin6_family
= AF_INET6
;
852 scm_to_ipv6 (soka
->sin6_addr
.s6_addr
, address
);
853 soka
->sin6_port
= htons (port
);
854 soka
->sin6_flowinfo
= flowinfo
;
855 #ifdef HAVE_SIN6_SCOPE_ID
856 soka
->sin6_scope_id
= scope_id
;
858 *size
= sizeof (struct sockaddr_in6
);
859 return (struct sockaddr
*) soka
;
862 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
865 struct sockaddr_un
*soka
;
869 scm_dynwind_begin (0);
871 c_address
= scm_to_locale_string (address
);
872 scm_dynwind_free (c_address
);
874 /* the static buffer size in sockaddr_un seems to be arbitrary
875 and not necessarily a hard limit. e.g., the glibc manual
876 suggests it may be possible to declare it size 0. let's
877 ignore it. if the O/S doesn't like the size it will cause
878 connect/bind etc., to fail. sun_path is always the last
879 member of the structure. */
880 addr_size
= sizeof (struct sockaddr_un
)
881 + max (0, strlen (c_address
) + 1 - (sizeof soka
->sun_path
));
882 soka
= (struct sockaddr_un
*) scm_malloc (addr_size
);
883 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
884 soka
->sun_family
= AF_UNIX
;
885 strcpy (soka
->sun_path
, c_address
);
886 *size
= SUN_LEN (soka
);
889 return (struct sockaddr
*) soka
;
893 scm_out_of_range (proc
, scm_from_int (fam
));
898 SCM_DEFINE (scm_connect
, "connect", 2, 1, 1,
899 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
900 "Initiate a connection from a socket using a specified address\n"
901 "family to the address\n"
902 "specified by @var{address} and possibly @var{args}.\n"
903 "The format required for @var{address}\n"
904 "and @var{args} depends on the family of the socket.\n\n"
905 "For a socket of family @code{AF_UNIX},\n"
906 "only @var{address} is specified and must be a string with the\n"
907 "filename where the socket is to be created.\n\n"
908 "For a socket of family @code{AF_INET},\n"
909 "@var{address} must be an integer IPv4 host address and\n"
910 "@var{args} must be a single integer port number.\n\n"
911 "For a socket of family @code{AF_INET6},\n"
912 "@var{address} must be an integer IPv6 host address and\n"
913 "@var{args} may be up to three integers:\n"
914 "port [flowinfo] [scope_id],\n"
915 "where flowinfo and scope_id default to zero.\n\n"
916 "Alternatively, the second argument can be a socket address object "
917 "as returned by @code{make-socket-address}, in which case the "
918 "no additional arguments should be passed.\n\n"
919 "The return value is unspecified.")
920 #define FUNC_NAME s_scm_connect
923 struct sockaddr
*soka
;
926 sock
= SCM_COERCE_OUTPORT (sock
);
927 SCM_VALIDATE_OPFPORT (1, sock
);
928 fd
= SCM_FPORT_FDES (sock
);
930 if (address
== SCM_UNDEFINED
)
931 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
932 `socket address' object. */
933 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
935 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
936 &args
, 3, FUNC_NAME
, &size
);
938 if (connect (fd
, soka
, size
) == -1)
940 int save_errno
= errno
;
947 return SCM_UNSPECIFIED
;
951 SCM_DEFINE (scm_bind
, "bind", 2, 1, 1,
952 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
953 "Assign an address to the socket port @var{sock}.\n"
954 "Generally this only needs to be done for server sockets,\n"
955 "so they know where to look for incoming connections. A socket\n"
956 "without an address will be assigned one automatically when it\n"
957 "starts communicating.\n\n"
958 "The format of @var{address} and @var{args} depends\n"
959 "on the family of the socket.\n\n"
960 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
961 "is specified and must be a string with the filename where\n"
962 "the socket is to be created.\n\n"
963 "For a socket of family @code{AF_INET}, @var{address}\n"
964 "must be an integer IPv4 address and @var{args}\n"
965 "must be a single integer port number.\n\n"
966 "The values of the following variables can also be used for\n"
968 "@defvar INADDR_ANY\n"
969 "Allow connections from any address.\n"
971 "@defvar INADDR_LOOPBACK\n"
972 "The address of the local host using the loopback device.\n"
974 "@defvar INADDR_BROADCAST\n"
975 "The broadcast address on the local network.\n"
977 "@defvar INADDR_NONE\n"
980 "For a socket of family @code{AF_INET6}, @var{address}\n"
981 "must be an integer IPv6 address and @var{args}\n"
982 "may be up to three integers:\n"
983 "port [flowinfo] [scope_id],\n"
984 "where flowinfo and scope_id default to zero.\n\n"
985 "Alternatively, the second argument can be a socket address object "
986 "as returned by @code{make-socket-address}, in which case the "
987 "no additional arguments should be passed.\n\n"
988 "The return value is unspecified.")
989 #define FUNC_NAME s_scm_bind
991 struct sockaddr
*soka
;
995 sock
= SCM_COERCE_OUTPORT (sock
);
996 SCM_VALIDATE_OPFPORT (1, sock
);
997 fd
= SCM_FPORT_FDES (sock
);
999 if (address
== SCM_UNDEFINED
)
1000 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
1001 `socket address' object. */
1002 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
1004 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
1005 &args
, 3, FUNC_NAME
, &size
);
1008 if (bind (fd
, soka
, size
) == -1)
1010 int save_errno
= errno
;
1017 return SCM_UNSPECIFIED
;
1021 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
1022 (SCM sock
, SCM backlog
),
1023 "Enable @var{sock} to accept connection\n"
1024 "requests. @var{backlog} is an integer specifying\n"
1025 "the maximum length of the queue for pending connections.\n"
1026 "If the queue fills, new clients will fail to connect until\n"
1027 "the server calls @code{accept} to accept a connection from\n"
1029 "The return value is unspecified.")
1030 #define FUNC_NAME s_scm_listen
1033 sock
= SCM_COERCE_OUTPORT (sock
);
1034 SCM_VALIDATE_OPFPORT (1, sock
);
1035 fd
= SCM_FPORT_FDES (sock
);
1036 if (listen (fd
, scm_to_int (backlog
)) == -1)
1038 return SCM_UNSPECIFIED
;
1042 /* Put the components of a sockaddr into a new SCM vector. */
1043 static SCM_C_INLINE_KEYWORD SCM
1044 _scm_from_sockaddr (const scm_t_max_sockaddr
*address
, unsigned addr_size
,
1047 SCM result
= SCM_EOL
;
1048 short int fam
= ((struct sockaddr
*) address
)->sa_family
;
1054 const struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
1056 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
1058 SCM_SIMPLE_VECTOR_SET(result
, 0,
1059 scm_from_short (fam
));
1060 SCM_SIMPLE_VECTOR_SET(result
, 1,
1061 scm_from_ulong (ntohl (nad
->sin_addr
.s_addr
)));
1062 SCM_SIMPLE_VECTOR_SET(result
, 2,
1063 scm_from_ushort (ntohs (nad
->sin_port
)));
1069 const struct sockaddr_in6
*nad
= (struct sockaddr_in6
*) address
;
1071 result
= scm_c_make_vector (5, SCM_UNSPECIFIED
);
1072 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1073 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_ipv6 (nad
->sin6_addr
.s6_addr
));
1074 SCM_SIMPLE_VECTOR_SET(result
, 2, scm_from_ushort (ntohs (nad
->sin6_port
)));
1075 SCM_SIMPLE_VECTOR_SET(result
, 3, scm_from_uint32 (nad
->sin6_flowinfo
));
1076 #ifdef HAVE_SIN6_SCOPE_ID
1077 SCM_SIMPLE_VECTOR_SET(result
, 4, scm_from_ulong (nad
->sin6_scope_id
));
1079 SCM_SIMPLE_VECTOR_SET(result
, 4, SCM_INUM0
);
1084 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1087 const struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
1089 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
1091 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1092 /* When addr_size is not enough to cover sun_path, do not try
1094 if (addr_size
<= offsetof (struct sockaddr_un
, sun_path
))
1095 SCM_SIMPLE_VECTOR_SET(result
, 1, SCM_BOOL_F
);
1097 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_locale_string (nad
->sun_path
));
1102 result
= SCM_UNSPECIFIED
;
1103 scm_misc_error (proc
, "unrecognised address family: ~A",
1104 scm_list_1 (scm_from_int (fam
)));
1110 /* The publicly-visible function. Return a Scheme object representing
1111 ADDRESS, an address of ADDR_SIZE bytes. */
1113 scm_from_sockaddr (const struct sockaddr
*address
, unsigned addr_size
)
1115 return (_scm_from_sockaddr ((scm_t_max_sockaddr
*) address
,
1116 addr_size
, "scm_from_sockaddr"));
1119 /* Convert ADDRESS, an address object returned by either
1120 `scm_from_sockaddr ()' or `scm_make_socket_address ()', into its C
1121 representation. On success, a non-NULL pointer is returned and
1122 ADDRESS_SIZE is updated to the actual size (in bytes) of the returned
1123 address. The result must eventually be freed using `free ()'. */
1125 scm_to_sockaddr (SCM address
, size_t *address_size
)
1126 #define FUNC_NAME "scm_to_sockaddr"
1129 struct sockaddr
*c_address
= NULL
;
1131 SCM_VALIDATE_VECTOR (1, address
);
1134 family
= scm_to_short (SCM_SIMPLE_VECTOR_REF (address
, 0));
1140 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 3)
1141 scm_misc_error (FUNC_NAME
,
1142 "invalid inet address representation: ~A",
1143 scm_list_1 (address
));
1146 struct sockaddr_in c_inet
;
1148 c_inet
.sin_addr
.s_addr
=
1149 htonl (scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 1)));
1151 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1152 c_inet
.sin_family
= AF_INET
;
1154 *address_size
= sizeof (c_inet
);
1155 c_address
= scm_malloc (sizeof (c_inet
));
1156 memcpy (c_address
, &c_inet
, sizeof (c_inet
));
1165 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 5)
1166 scm_misc_error (FUNC_NAME
, "invalid inet6 address representation: ~A",
1167 scm_list_1 (address
));
1170 struct sockaddr_in6 c_inet6
;
1172 scm_to_ipv6 (c_inet6
.sin6_addr
.s6_addr
,
1173 SCM_SIMPLE_VECTOR_REF (address
, 1));
1175 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1176 c_inet6
.sin6_flowinfo
=
1177 scm_to_uint32 (SCM_SIMPLE_VECTOR_REF (address
, 3));
1178 #ifdef HAVE_SIN6_SCOPE_ID
1179 c_inet6
.sin6_scope_id
=
1180 scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 4));
1183 c_inet6
.sin6_family
= AF_INET6
;
1185 *address_size
= sizeof (c_inet6
);
1186 c_address
= scm_malloc (sizeof (c_inet6
));
1187 memcpy (c_address
, &c_inet6
, sizeof (c_inet6
));
1194 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1197 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 2)
1198 scm_misc_error (FUNC_NAME
, "invalid unix address representation: ~A",
1199 scm_list_1 (address
));
1203 size_t path_len
= 0;
1205 path
= SCM_SIMPLE_VECTOR_REF (address
, 1);
1206 if ((!scm_is_string (path
)) && (path
!= SCM_BOOL_F
))
1207 scm_misc_error (FUNC_NAME
, "invalid unix address "
1208 "path: ~A", scm_list_1 (path
));
1211 struct sockaddr_un c_unix
;
1213 if (path
== SCM_BOOL_F
)
1216 path_len
= scm_c_string_length (path
);
1218 #ifdef UNIX_PATH_MAX
1219 if (path_len
>= UNIX_PATH_MAX
)
1221 /* We can hope that this limit will eventually vanish, at least on GNU.
1222 However, currently, while glibc doesn't define `UNIX_PATH_MAX', it
1223 documents it has being limited to 108 bytes. */
1224 if (path_len
>= sizeof (c_unix
.sun_path
))
1226 scm_misc_error (FUNC_NAME
, "unix address path "
1227 "too long: ~A", scm_list_1 (path
));
1232 scm_to_locale_stringbuf (path
, c_unix
.sun_path
,
1233 #ifdef UNIX_PATH_MAX
1236 sizeof (c_unix
.sun_path
));
1238 c_unix
.sun_path
[path_len
] = '\0';
1241 if (strlen (c_unix
.sun_path
) != path_len
)
1242 scm_misc_error (FUNC_NAME
, "unix address path "
1243 "contains nul characters: ~A",
1247 c_unix
.sun_path
[0] = '\0';
1249 c_unix
.sun_family
= AF_UNIX
;
1251 *address_size
= SUN_LEN (&c_unix
);
1252 c_address
= scm_malloc (sizeof (c_unix
));
1253 memcpy (c_address
, &c_unix
, sizeof (c_unix
));
1263 scm_misc_error (FUNC_NAME
, "unrecognised address family: ~A",
1264 scm_list_1 (scm_from_ushort (family
)));
1272 /* Return a newly-allocated `sockaddr' structure that reflects ADDRESS, being
1273 an address of family FAMILY, with the family-specific parameters ARGS (see
1274 the description of `connect' for details). The returned structure may be
1275 freed using `free ()'. */
1277 scm_c_make_socket_address (SCM family
, SCM address
, SCM args
,
1278 size_t *address_size
)
1280 struct sockaddr
*soka
;
1282 soka
= scm_fill_sockaddr (scm_to_ushort (family
), address
, &args
, 1,
1283 "scm_c_make_socket_address", address_size
);
1288 SCM_DEFINE (scm_make_socket_address
, "make-socket-address", 2, 0, 1,
1289 (SCM family
, SCM address
, SCM args
),
1290 "Return a Scheme address object that reflects @var{address}, "
1291 "being an address of family @var{family}, with the "
1292 "family-specific parameters @var{args} (see the description of "
1293 "@code{connect} for details).")
1294 #define FUNC_NAME s_scm_make_socket_address
1296 SCM result
= SCM_BOOL_F
;
1297 struct sockaddr
*c_address
;
1298 size_t c_address_size
;
1300 c_address
= scm_c_make_socket_address (family
, address
, args
,
1302 if (c_address
!= NULL
)
1304 result
= scm_from_sockaddr (c_address
, c_address_size
);
1313 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
1315 "Accept a connection on a bound, listening socket.\n"
1317 "are no pending connections in the queue, wait until\n"
1318 "one is available unless the non-blocking option has been\n"
1319 "set on the socket.\n\n"
1320 "The return value is a\n"
1321 "pair in which the @emph{car} is a new socket port for the\n"
1323 "the @emph{cdr} is an object with address information about the\n"
1324 "client which initiated the connection.\n\n"
1325 "@var{sock} does not become part of the\n"
1326 "connection and will continue to accept new requests.")
1327 #define FUNC_NAME s_scm_accept
1333 SELECT_TYPE readfds
, exceptfds
;
1334 socklen_t addr_size
= MAX_ADDR_SIZE
;
1335 scm_t_max_sockaddr addr
;
1337 sock
= SCM_COERCE_OUTPORT (sock
);
1338 SCM_VALIDATE_OPFPORT (1, sock
);
1339 fd
= SCM_FPORT_FDES (sock
);
1342 FD_ZERO (&exceptfds
);
1343 FD_SET (fd
, &readfds
);
1344 FD_SET (fd
, &exceptfds
);
1346 /* Block until something happens on FD, leaving guile mode while
1348 selected
= scm_std_select (fd
+ 1, &readfds
, NULL
, &exceptfds
,
1353 newfd
= accept (fd
, (struct sockaddr
*) &addr
, &addr_size
);
1356 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
1357 address
= _scm_from_sockaddr (&addr
, addr_size
,
1360 return scm_cons (newsock
, address
);
1364 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
1366 "Return the address of @var{sock}, in the same form as the\n"
1367 "object returned by @code{accept}. On many systems the address\n"
1368 "of a socket in the @code{AF_FILE} namespace cannot be read.")
1369 #define FUNC_NAME s_scm_getsockname
1372 socklen_t addr_size
= MAX_ADDR_SIZE
;
1373 scm_t_max_sockaddr addr
;
1375 sock
= SCM_COERCE_OUTPORT (sock
);
1376 SCM_VALIDATE_OPFPORT (1, sock
);
1377 fd
= SCM_FPORT_FDES (sock
);
1378 if (getsockname (fd
, (struct sockaddr
*) &addr
, &addr_size
) == -1)
1381 return _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1385 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
1387 "Return the address that @var{sock}\n"
1388 "is connected to, in the same form as the object returned by\n"
1389 "@code{accept}. On many systems the address of a socket in the\n"
1390 "@code{AF_FILE} namespace cannot be read.")
1391 #define FUNC_NAME s_scm_getpeername
1394 socklen_t addr_size
= MAX_ADDR_SIZE
;
1395 scm_t_max_sockaddr addr
;
1397 sock
= SCM_COERCE_OUTPORT (sock
);
1398 SCM_VALIDATE_OPFPORT (1, sock
);
1399 fd
= SCM_FPORT_FDES (sock
);
1400 if (getpeername (fd
, (struct sockaddr
*) &addr
, &addr_size
) == -1)
1403 return _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1407 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
1408 (SCM sock
, SCM buf
, SCM flags
),
1409 "Receive data from a socket port.\n"
1410 "@var{sock} must already\n"
1411 "be bound to the address from which data is to be received.\n"
1412 "@var{buf} is a string into which\n"
1413 "the data will be written. The size of @var{buf} limits\n"
1415 "data which can be received: in the case of packet\n"
1416 "protocols, if a packet larger than this limit is encountered\n"
1418 "will be irrevocably lost.\n\n"
1419 "The data is assumed to be binary, and there is no decoding of\n"
1420 "of locale-encoded strings.\n\n"
1421 "The optional @var{flags} argument is a value or\n"
1422 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1423 "The value returned is the number of bytes read from the\n"
1425 "Note that the data is read directly from the socket file\n"
1427 "any unread buffered port data is ignored.")
1428 #define FUNC_NAME s_scm_recv
1437 SCM_VALIDATE_OPFPORT (1, sock
);
1438 SCM_VALIDATE_STRING (2, buf
);
1439 if (SCM_UNBNDP (flags
))
1442 flg
= scm_to_int (flags
);
1443 fd
= SCM_FPORT_FDES (sock
);
1445 len
= scm_i_string_length (buf
);
1446 msg
= scm_i_make_string (len
, &dest
);
1447 SCM_SYSCALL (rv
= recv (fd
, dest
, len
, flg
));
1448 scm_string_copy_x (buf
, scm_from_int (0),
1449 msg
, scm_from_int (0), scm_from_size_t (len
));
1454 scm_remember_upto_here_2 (buf
, msg
);
1455 return scm_from_int (rv
);
1459 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
1460 (SCM sock
, SCM message
, SCM flags
),
1461 "Transmit the string @var{message} on a socket port @var{sock}.\n"
1462 "@var{sock} must already be bound to a destination address. The\n"
1463 "value returned is the number of bytes transmitted --\n"
1464 "it's possible for\n"
1465 "this to be less than the length of @var{message}\n"
1466 "if the socket is\n"
1467 "set to be non-blocking. The optional @var{flags} argument\n"
1469 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1470 "Note that the data is written directly to the socket\n"
1471 "file descriptor:\n"
1472 "any unflushed buffered port data is ignored.\n\n"
1473 "This operation is defined only for strings containing codepoints\n"
1475 #define FUNC_NAME s_scm_send
1483 sock
= SCM_COERCE_OUTPORT (sock
);
1484 SCM_VALIDATE_OPFPORT (1, sock
);
1485 SCM_VALIDATE_STRING (2, message
);
1487 /* If the string is wide, see if it can be coerced into
1489 if (!scm_i_is_narrow_string (message
)
1490 || scm_i_try_narrow_string (message
))
1491 SCM_MISC_ERROR ("the message string is not 8-bit: ~s",
1492 scm_list_1 (message
));
1494 if (SCM_UNBNDP (flags
))
1497 flg
= scm_to_int (flags
);
1498 fd
= SCM_FPORT_FDES (sock
);
1500 len
= scm_i_string_length (message
);
1501 message
= scm_i_string_start_writing (message
);
1502 src
= scm_i_string_writable_chars (message
);
1503 SCM_SYSCALL (rv
= send (fd
, src
, len
, flg
));
1504 scm_i_string_stop_writing ();
1509 scm_remember_upto_here_1 (message
);
1510 return scm_from_int (rv
);
1514 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
1515 (SCM sock
, SCM str
, SCM flags
, SCM start
, SCM end
),
1516 "Receive data from socket port @var{sock} (which must be already\n"
1517 "bound), returning the originating address as well as the data.\n"
1518 "This is usually for use on datagram sockets, but can be used on\n"
1519 "stream-oriented sockets too.\n"
1521 "The data received is stored in the given @var{str}, using\n"
1522 "either the whole string or just the region between the optional\n"
1523 "@var{start} and @var{end} positions. The size of @var{str}\n"
1524 "limits the amount of data which can be received. For datagram\n"
1525 "protocols, if a packet larger than this is received then excess\n"
1526 "bytes are irrevocably lost.\n"
1528 "The return value is a pair. The @code{car} is the number of\n"
1529 "bytes read. The @code{cdr} is a socket address object which is\n"
1530 "where the data come from, or @code{#f} if the origin is\n"
1533 "The optional @var{flags} argument is a or bitwise OR\n"
1534 "(@code{logior}) of @code{MSG_OOB}, @code{MSG_PEEK},\n"
1535 "@code{MSG_DONTROUTE} etc.\n"
1537 "Data is read directly from the socket file descriptor, any\n"
1538 "buffered port data is ignored.\n"
1540 "On a GNU/Linux system @code{recvfrom!} is not multi-threading,\n"
1541 "all threads stop while a @code{recvfrom!} call is in progress.\n"
1542 "An application may need to use @code{select}, @code{O_NONBLOCK}\n"
1543 "or @code{MSG_DONTWAIT} to avoid this.")
1544 #define FUNC_NAME s_scm_recvfrom
1553 socklen_t addr_size
= MAX_ADDR_SIZE
;
1554 scm_t_max_sockaddr addr
;
1556 SCM_VALIDATE_OPFPORT (1, sock
);
1557 fd
= SCM_FPORT_FDES (sock
);
1559 SCM_VALIDATE_STRING (2, str
);
1560 scm_i_get_substring_spec (scm_i_string_length (str
),
1561 start
, &offset
, end
, &cend
);
1563 if (SCM_UNBNDP (flags
))
1566 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
1568 /* recvfrom will not necessarily return an address. usually nothing
1569 is returned for stream sockets. */
1570 str
= scm_i_string_start_writing (str
);
1571 buf
= scm_i_string_writable_chars (str
);
1572 ((struct sockaddr
*) &addr
)->sa_family
= AF_UNSPEC
;
1573 SCM_SYSCALL (rv
= recvfrom (fd
, buf
+ offset
,
1575 (struct sockaddr
*) &addr
, &addr_size
));
1576 scm_i_string_stop_writing ();
1580 if (((struct sockaddr
*) &addr
)->sa_family
!= AF_UNSPEC
)
1581 address
= _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1583 address
= SCM_BOOL_F
;
1585 scm_remember_upto_here_1 (str
);
1587 return scm_cons (scm_from_int (rv
), address
);
1591 SCM_DEFINE (scm_sendto
, "sendto", 3, 1, 1,
1592 (SCM sock
, SCM message
, SCM fam_or_sockaddr
, SCM address
, SCM args_and_flags
),
1593 "Transmit the string @var{message} on the socket port\n"
1595 "destination address is specified using the @var{fam},\n"
1596 "@var{address} and\n"
1597 "@var{args_and_flags} arguments, or just a socket address object "
1598 "returned by @code{make-socket-address}, in a similar way to the\n"
1599 "@code{connect} procedure. @var{args_and_flags} contains\n"
1600 "the usual connection arguments optionally followed by\n"
1601 "a flags argument, which is a value or\n"
1602 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1603 "The value returned is the number of bytes transmitted --\n"
1604 "it's possible for\n"
1605 "this to be less than the length of @var{message} if the\n"
1607 "set to be non-blocking.\n"
1608 "Note that the data is written directly to the socket\n"
1609 "file descriptor:\n"
1610 "any unflushed buffered port data is ignored.\n"
1611 "This operation is defined only for strings containing codepoints\n"
1613 #define FUNC_NAME s_scm_sendto
1618 struct sockaddr
*soka
;
1621 sock
= SCM_COERCE_OUTPORT (sock
);
1622 SCM_VALIDATE_FPORT (1, sock
);
1623 SCM_VALIDATE_STRING (2, message
);
1624 fd
= SCM_FPORT_FDES (sock
);
1626 if (!scm_is_number (fam_or_sockaddr
))
1628 /* FAM_OR_SOCKADDR must actually be a `socket address' object. This
1629 means that the following arguments, i.e. ADDRESS and those listed in
1630 ARGS_AND_FLAGS, are the `MSG_' flags. */
1631 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
1632 if (address
!= SCM_UNDEFINED
)
1633 args_and_flags
= scm_cons (address
, args_and_flags
);
1636 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
1637 &args_and_flags
, 3, FUNC_NAME
, &size
);
1639 if (scm_is_null (args_and_flags
))
1643 SCM_VALIDATE_CONS (5, args_and_flags
);
1644 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
1646 SCM_SYSCALL (rv
= sendto (fd
,
1647 scm_i_string_chars (message
),
1648 scm_i_string_length (message
),
1652 int save_errno
= errno
;
1659 scm_remember_upto_here_1 (message
);
1660 return scm_from_int (rv
);
1669 /* protocol families. */
1671 scm_c_define ("AF_UNSPEC", scm_from_int (AF_UNSPEC
));
1674 scm_c_define ("AF_UNIX", scm_from_int (AF_UNIX
));
1677 scm_c_define ("AF_INET", scm_from_int (AF_INET
));
1680 scm_c_define ("AF_INET6", scm_from_int (AF_INET6
));
1684 scm_c_define ("PF_UNSPEC", scm_from_int (PF_UNSPEC
));
1687 scm_c_define ("PF_UNIX", scm_from_int (PF_UNIX
));
1690 scm_c_define ("PF_INET", scm_from_int (PF_INET
));
1693 scm_c_define ("PF_INET6", scm_from_int (PF_INET6
));
1696 /* standard addresses. */
1698 scm_c_define ("INADDR_ANY", scm_from_ulong (INADDR_ANY
));
1700 #ifdef INADDR_BROADCAST
1701 scm_c_define ("INADDR_BROADCAST", scm_from_ulong (INADDR_BROADCAST
));
1704 scm_c_define ("INADDR_NONE", scm_from_ulong (INADDR_NONE
));
1706 #ifdef INADDR_LOOPBACK
1707 scm_c_define ("INADDR_LOOPBACK", scm_from_ulong (INADDR_LOOPBACK
));
1712 SOCK_PACKET is deliberately omitted, the GNU/Linux socket(2) and
1713 packet(7) advise that it's obsolete and strongly deprecated. */
1716 scm_c_define ("SOCK_STREAM", scm_from_int (SOCK_STREAM
));
1719 scm_c_define ("SOCK_DGRAM", scm_from_int (SOCK_DGRAM
));
1721 #ifdef SOCK_SEQPACKET
1722 scm_c_define ("SOCK_SEQPACKET", scm_from_int (SOCK_SEQPACKET
));
1725 scm_c_define ("SOCK_RAW", scm_from_int (SOCK_RAW
));
1728 scm_c_define ("SOCK_RDM", scm_from_int (SOCK_RDM
));
1731 /* setsockopt level.
1733 SOL_IP, SOL_TCP and SOL_UDP are defined on gnu/linux, but not on for
1734 instance NetBSD. We define IPPROTOs because that's what the posix spec
1735 shows in its example at
1737 http://www.opengroup.org/onlinepubs/007904975/functions/getsockopt.html
1740 scm_c_define ("SOL_SOCKET", scm_from_int (SOL_SOCKET
));
1743 scm_c_define ("IPPROTO_IP", scm_from_int (IPPROTO_IP
));
1746 scm_c_define ("IPPROTO_TCP", scm_from_int (IPPROTO_TCP
));
1749 scm_c_define ("IPPROTO_UDP", scm_from_int (IPPROTO_UDP
));
1752 /* setsockopt names. */
1754 scm_c_define ("SO_DEBUG", scm_from_int (SO_DEBUG
));
1757 scm_c_define ("SO_REUSEADDR", scm_from_int (SO_REUSEADDR
));
1760 scm_c_define ("SO_STYLE", scm_from_int (SO_STYLE
));
1763 scm_c_define ("SO_TYPE", scm_from_int (SO_TYPE
));
1766 scm_c_define ("SO_ERROR", scm_from_int (SO_ERROR
));
1769 scm_c_define ("SO_DONTROUTE", scm_from_int (SO_DONTROUTE
));
1772 scm_c_define ("SO_BROADCAST", scm_from_int (SO_BROADCAST
));
1775 scm_c_define ("SO_SNDBUF", scm_from_int (SO_SNDBUF
));
1778 scm_c_define ("SO_RCVBUF", scm_from_int (SO_RCVBUF
));
1781 scm_c_define ("SO_KEEPALIVE", scm_from_int (SO_KEEPALIVE
));
1784 scm_c_define ("SO_OOBINLINE", scm_from_int (SO_OOBINLINE
));
1787 scm_c_define ("SO_NO_CHECK", scm_from_int (SO_NO_CHECK
));
1790 scm_c_define ("SO_PRIORITY", scm_from_int (SO_PRIORITY
));
1793 scm_c_define ("SO_LINGER", scm_from_int (SO_LINGER
));
1796 /* recv/send options. */
1798 scm_c_define ("MSG_DONTWAIT", scm_from_int (MSG_DONTWAIT
));
1801 scm_c_define ("MSG_OOB", scm_from_int (MSG_OOB
));
1804 scm_c_define ("MSG_PEEK", scm_from_int (MSG_PEEK
));
1806 #ifdef MSG_DONTROUTE
1807 scm_c_define ("MSG_DONTROUTE", scm_from_int (MSG_DONTROUTE
));
1811 scm_i_init_socket_Win32 ();
1814 #ifdef IP_ADD_MEMBERSHIP
1815 scm_c_define ("IP_ADD_MEMBERSHIP", scm_from_int (IP_ADD_MEMBERSHIP
));
1816 scm_c_define ("IP_DROP_MEMBERSHIP", scm_from_int (IP_DROP_MEMBERSHIP
));
1819 scm_add_feature ("socket");
1821 #include "libguile/socket.x"