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 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/unif.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"
37 #include "libguile/validate.h"
38 #include "libguile/socket.h"
40 #include "libguile/iselect.h"
43 #include "win32-socket.h"
55 #include <sys/types.h>
56 #ifdef HAVE_WINSOCK2_H
59 #include <sys/socket.h>
60 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
63 #include <netinet/in.h>
65 #include <arpa/inet.h>
68 #if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
69 #define SUN_LEN(ptr) ((size_t) (((struct sockaddr_un *) 0)->sun_path) \
70 + strlen ((ptr)->sun_path))
73 /* The largest possible socket address. Wrapping it in a union guarantees
74 that the compiler will make it suitably aligned. */
77 struct sockaddr sockaddr
;
78 struct sockaddr_in sockaddr_in
;
80 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
81 struct sockaddr_un sockaddr_un
;
84 struct sockaddr_in6 sockaddr_in6
;
89 /* Maximum size of a socket address. */
90 #define MAX_ADDR_SIZE (sizeof (scm_t_max_sockaddr))
95 SCM_DEFINE (scm_htons
, "htons", 1, 0, 0,
97 "Convert a 16 bit quantity from host to network byte ordering.\n"
98 "@var{value} is packed into 2 bytes, which are then converted\n"
99 "and returned as a new integer.")
100 #define FUNC_NAME s_scm_htons
102 return scm_from_ushort (htons (scm_to_ushort (value
)));
106 SCM_DEFINE (scm_ntohs
, "ntohs", 1, 0, 0,
108 "Convert a 16 bit quantity from network to host byte ordering.\n"
109 "@var{value} is packed into 2 bytes, which are then converted\n"
110 "and returned as a new integer.")
111 #define FUNC_NAME s_scm_ntohs
113 return scm_from_ushort (ntohs (scm_to_ushort (value
)));
117 SCM_DEFINE (scm_htonl
, "htonl", 1, 0, 0,
119 "Convert a 32 bit quantity from host to network byte ordering.\n"
120 "@var{value} is packed into 4 bytes, which are then converted\n"
121 "and returned as a new integer.")
122 #define FUNC_NAME s_scm_htonl
124 return scm_from_ulong (htonl (scm_to_uint32 (value
)));
128 SCM_DEFINE (scm_ntohl
, "ntohl", 1, 0, 0,
130 "Convert a 32 bit quantity from network to host byte ordering.\n"
131 "@var{value} is packed into 4 bytes, which are then converted\n"
132 "and returned as a new integer.")
133 #define FUNC_NAME s_scm_ntohl
135 return scm_from_ulong (ntohl (scm_to_uint32 (value
)));
139 #ifndef HAVE_INET_ATON
140 /* for our definition in inet_aton.c, not usually needed. */
141 extern int inet_aton ();
144 SCM_DEFINE (scm_inet_aton
, "inet-aton", 1, 0, 0,
146 "Convert an IPv4 Internet address from printable string\n"
147 "(dotted decimal notation) to an integer. E.g.,\n\n"
149 "(inet-aton \"127.0.0.1\") @result{} 2130706433\n"
151 #define FUNC_NAME s_scm_inet_aton
157 c_address
= scm_to_locale_string (address
);
158 rv
= inet_aton (c_address
, &soka
);
161 SCM_MISC_ERROR ("bad address", SCM_EOL
);
162 return scm_from_ulong (ntohl (soka
.s_addr
));
167 SCM_DEFINE (scm_inet_ntoa
, "inet-ntoa", 1, 0, 0,
169 "Convert an IPv4 Internet address to a printable\n"
170 "(dotted decimal notation) string. E.g.,\n\n"
172 "(inet-ntoa 2130706433) @result{} \"127.0.0.1\"\n"
174 #define FUNC_NAME s_scm_inet_ntoa
179 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, inetid
));
180 s
= inet_ntoa (addr
);
181 answer
= scm_from_locale_string (s
);
186 #ifdef HAVE_INET_NETOF
187 SCM_DEFINE (scm_inet_netof
, "inet-netof", 1, 0, 0,
189 "Return the network number part of the given IPv4\n"
190 "Internet address. E.g.,\n\n"
192 "(inet-netof 2130706433) @result{} 127\n"
194 #define FUNC_NAME s_scm_inet_netof
197 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
198 return scm_from_ulong (inet_netof (addr
));
203 #ifdef HAVE_INET_LNAOF
204 SCM_DEFINE (scm_lnaof
, "inet-lnaof", 1, 0, 0,
206 "Return the local-address-with-network part of the given\n"
207 "IPv4 Internet address, using the obsolete class A/B/C system.\n"
210 "(inet-lnaof 2130706433) @result{} 1\n"
212 #define FUNC_NAME s_scm_lnaof
215 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
216 return scm_from_ulong (inet_lnaof (addr
));
221 #ifdef HAVE_INET_MAKEADDR
222 SCM_DEFINE (scm_inet_makeaddr
, "inet-makeaddr", 2, 0, 0,
224 "Make an IPv4 Internet address by combining the network number\n"
225 "@var{net} with the local-address-within-network number\n"
226 "@var{lna}. E.g.,\n\n"
228 "(inet-makeaddr 127 1) @result{} 2130706433\n"
230 #define FUNC_NAME s_scm_inet_makeaddr
233 unsigned long netnum
;
234 unsigned long lnanum
;
236 netnum
= SCM_NUM2ULONG (1, net
);
237 lnanum
= SCM_NUM2ULONG (2, lna
);
238 addr
= inet_makeaddr (netnum
, lnanum
);
239 return scm_from_ulong (ntohl (addr
.s_addr
));
246 /* flip a 128 bit IPv6 address between host and network order. */
247 #ifdef WORDS_BIGENDIAN
248 #define FLIP_NET_HOST_128(addr)
250 #define FLIP_NET_HOST_128(addr)\
254 for (i = 0; i < 8; i++)\
256 scm_t_uint8 c = (addr)[i];\
258 (addr)[i] = (addr)[15 - i];\
264 #ifdef WORDS_BIGENDIAN
265 #define FLIPCPY_NET_HOST_128(dest, src) memcpy (dest, src, 16)
267 #define FLIPCPY_NET_HOST_128(dest, src) \
269 const scm_t_uint8 *tmp_srcp = (src) + 15; \
270 scm_t_uint8 *tmp_destp = (dest); \
273 *tmp_destp++ = *tmp_srcp--; \
274 } while (tmp_srcp != (src)); \
279 #if (SIZEOF_SCM_T_BITS * SCM_CHAR_BIT) > 128
280 #error "Assumption that scm_t_bits <= 128 bits has been violated."
283 #if (SIZEOF_UNSIGNED_LONG * SCM_CHAR_BIT) > 128
284 #error "Assumption that unsigned long <= 128 bits has been violated."
287 #if (SIZEOF_UNSIGNED_LONG_LONG * SCM_CHAR_BIT) > 128
288 #error "Assumption that unsigned long long <= 128 bits has been violated."
291 /* convert a 128 bit IPv6 address in network order to a host ordered
294 scm_from_ipv6 (const scm_t_uint8
*src
)
296 SCM result
= scm_i_mkbig ();
297 mpz_import (SCM_I_BIG_MPZ (result
),
299 1, /* big-endian chunk ordering */
300 16, /* chunks are 16 bytes long */
301 1, /* big-endian byte ordering */
302 0, /* "nails" -- leading unused bits per chunk */
304 return scm_i_normbig (result
);
307 /* convert a host ordered SCM integer to a 128 bit IPv6 address in
310 scm_to_ipv6 (scm_t_uint8 dst
[16], SCM src
)
312 if (SCM_I_INUMP (src
))
314 scm_t_signed_bits n
= SCM_I_INUM (src
);
316 scm_out_of_range (NULL
, src
);
317 #ifdef WORDS_BIGENDIAN
318 memset (dst
, 0, 16 - sizeof (scm_t_signed_bits
));
319 memcpy (dst
+ (16 - sizeof (scm_t_signed_bits
)),
321 sizeof (scm_t_signed_bits
));
323 memset (dst
+ sizeof (scm_t_signed_bits
),
325 16 - sizeof (scm_t_signed_bits
));
326 /* FIXME: this pair of ops is kinda wasteful -- should rewrite as
327 a single loop perhaps, similar to the handling of bignums. */
328 memcpy (dst
, &n
, sizeof (scm_t_signed_bits
));
329 FLIP_NET_HOST_128 (dst
);
332 else if (SCM_BIGP (src
))
336 if ((mpz_sgn (SCM_I_BIG_MPZ (src
)) < 0)
337 || mpz_sizeinbase (SCM_I_BIG_MPZ (src
), 2) > 128)
338 scm_out_of_range (NULL
, src
);
343 1, /* big-endian chunk ordering */
344 16, /* chunks are 16 bytes long */
345 1, /* big-endian byte ordering */
346 0, /* "nails" -- leading unused bits per chunk */
347 SCM_I_BIG_MPZ (src
));
348 scm_remember_upto_here_1 (src
);
351 scm_wrong_type_arg (NULL
, 0, src
);
354 #ifdef HAVE_INET_PTON
355 SCM_DEFINE (scm_inet_pton
, "inet-pton", 2, 0, 0,
356 (SCM family
, SCM address
),
357 "Convert a string containing a printable network address to\n"
358 "an integer address. Note that unlike the C version of this\n"
360 "the result is an integer with normal host byte ordering.\n"
361 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
363 "(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
364 "(inet-pton AF_INET6 \"::1\") @result{} 1\n"
366 #define FUNC_NAME s_scm_inet_pton
373 af
= scm_to_int (family
);
374 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
375 src
= scm_to_locale_string (address
);
376 rv
= inet_pton (af
, src
, dst
);
383 SCM_MISC_ERROR ("Bad address", SCM_EOL
);
385 return scm_from_ulong (ntohl (*dst
));
387 return scm_from_ipv6 ((scm_t_uint8
*) dst
);
392 #ifdef HAVE_INET_NTOP
393 SCM_DEFINE (scm_inet_ntop
, "inet-ntop", 2, 0, 0,
394 (SCM family
, SCM address
),
395 "Convert a network address into a printable string.\n"
396 "Note that unlike the C version of this function,\n"
397 "the input is an integer with normal host byte ordering.\n"
398 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
400 "(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
401 "(inet-ntop AF_INET6 (- (expt 2 128) 1)) @result{}\n"
402 "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\n"
404 #define FUNC_NAME s_scm_inet_ntop
407 #ifdef INET6_ADDRSTRLEN
408 char dst
[INET6_ADDRSTRLEN
];
414 af
= scm_to_int (family
);
415 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
420 addr4
= htonl (SCM_NUM2ULONG (2, address
));
421 result
= inet_ntop (af
, &addr4
, dst
, sizeof (dst
));
427 scm_to_ipv6 ((scm_t_uint8
*) addr6
, address
);
428 result
= inet_ntop (af
, &addr6
, dst
, sizeof (dst
));
434 return scm_from_locale_string (dst
);
439 #endif /* HAVE_IPV6 */
441 SCM_SYMBOL (sym_socket
, "socket");
443 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
445 SCM_DEFINE (scm_socket
, "socket", 3, 0, 0,
446 (SCM family
, SCM style
, SCM proto
),
447 "Return a new socket port of the type specified by @var{family},\n"
448 "@var{style} and @var{proto}. All three parameters are\n"
449 "integers. Supported values for @var{family} are\n"
450 "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
451 "Typical values for @var{style} are @code{SOCK_STREAM},\n"
452 "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
453 "@var{proto} can be obtained from a protocol name using\n"
454 "@code{getprotobyname}. A value of zero specifies the default\n"
455 "protocol, which is usually right.\n\n"
456 "A single socket port cannot by used for communication until it\n"
457 "has been connected to another socket.")
458 #define FUNC_NAME s_scm_socket
462 fd
= socket (scm_to_int (family
),
467 return SCM_SOCK_FD_TO_PORT (fd
);
471 #ifdef HAVE_SOCKETPAIR
472 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
473 (SCM family
, SCM style
, SCM proto
),
474 "Return a pair of connected (but unnamed) socket ports of the\n"
475 "type specified by @var{family}, @var{style} and @var{proto}.\n"
476 "Many systems support only socket pairs of the @code{AF_UNIX}\n"
477 "family. Zero is likely to be the only meaningful value for\n"
479 #define FUNC_NAME s_scm_socketpair
484 fam
= scm_to_int (family
);
486 if (socketpair (fam
, scm_to_int (style
), scm_to_int (proto
), fd
) == -1)
489 return scm_cons (SCM_SOCK_FD_TO_PORT (fd
[0]), SCM_SOCK_FD_TO_PORT (fd
[1]));
494 /* Possible results for `getsockopt ()'. Wrapping it into a union guarantees
495 suitable alignment. */
498 #ifdef HAVE_STRUCT_LINGER
499 struct linger linger
;
503 } scm_t_getsockopt_result
;
505 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
506 (SCM sock
, SCM level
, SCM optname
),
507 "Return an option value from socket port @var{sock}.\n"
509 "@var{level} is an integer specifying a protocol layer, either\n"
510 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
511 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
512 "(@pxref{Network Databases}).\n"
514 "@defvar SOL_SOCKET\n"
515 "@defvarx IPPROTO_IP\n"
516 "@defvarx IPPROTO_TCP\n"
517 "@defvarx IPPROTO_UDP\n"
520 "@var{optname} is an integer specifying an option within the\n"
523 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
524 "defined (when provided by the system). For their meaning see\n"
525 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
526 "Manual}, or @command{man 7 socket}.\n"
529 "@defvarx SO_REUSEADDR\n"
530 "@defvarx SO_STYLE\n"
532 "@defvarx SO_ERROR\n"
533 "@defvarx SO_DONTROUTE\n"
534 "@defvarx SO_BROADCAST\n"
535 "@defvarx SO_SNDBUF\n"
536 "@defvarx SO_RCVBUF\n"
537 "@defvarx SO_KEEPALIVE\n"
538 "@defvarx SO_OOBINLINE\n"
539 "@defvarx SO_NO_CHECK\n"
540 "@defvarx SO_PRIORITY\n"
541 "The value returned is an integer.\n"
544 "@defvar SO_LINGER\n"
545 "The @var{value} returned is a pair of integers\n"
546 "@code{(@var{ENABLE} . @var{TIMEOUT})}. On old systems without\n"
547 "timeout support (ie.@: without @code{struct linger}), only\n"
548 "@var{ENABLE} has an effect but the value in Guile is always a\n"
551 #define FUNC_NAME s_scm_getsockopt
554 /* size of optval is the largest supported option. */
555 scm_t_getsockopt_result optval
;
556 socklen_t optlen
= sizeof (optval
);
560 sock
= SCM_COERCE_OUTPORT (sock
);
561 SCM_VALIDATE_OPFPORT (1, sock
);
562 ilevel
= scm_to_int (level
);
563 ioptname
= scm_to_int (optname
);
565 fd
= SCM_FPORT_FDES (sock
);
566 if (getsockopt (fd
, ilevel
, ioptname
, (void *) &optval
, &optlen
) == -1)
569 if (ilevel
== SOL_SOCKET
)
572 if (ioptname
== SO_LINGER
)
574 #ifdef HAVE_STRUCT_LINGER
575 struct linger
*ling
= (struct linger
*) &optval
;
577 return scm_cons (scm_from_long (ling
->l_onoff
),
578 scm_from_long (ling
->l_linger
));
580 return scm_cons (scm_from_long (*(int *) &optval
),
588 || ioptname
== SO_SNDBUF
591 || ioptname
== SO_RCVBUF
595 return scm_from_size_t (*(size_t *) &optval
);
598 return scm_from_int (*(int *) &optval
);
602 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
603 (SCM sock
, SCM level
, SCM optname
, SCM value
),
604 "Set an option on socket port @var{sock}. The return value is\n"
607 "@var{level} is an integer specifying a protocol layer, either\n"
608 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
609 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
610 "(@pxref{Network Databases}).\n"
612 "@defvar SOL_SOCKET\n"
613 "@defvarx IPPROTO_IP\n"
614 "@defvarx IPPROTO_TCP\n"
615 "@defvarx IPPROTO_UDP\n"
618 "@var{optname} is an integer specifying an option within the\n"
621 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
622 "defined (when provided by the system). For their meaning see\n"
623 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
624 "Manual}, or @command{man 7 socket}.\n"
627 "@defvarx SO_REUSEADDR\n"
628 "@defvarx SO_STYLE\n"
630 "@defvarx SO_ERROR\n"
631 "@defvarx SO_DONTROUTE\n"
632 "@defvarx SO_BROADCAST\n"
633 "@defvarx SO_SNDBUF\n"
634 "@defvarx SO_RCVBUF\n"
635 "@defvarx SO_KEEPALIVE\n"
636 "@defvarx SO_OOBINLINE\n"
637 "@defvarx SO_NO_CHECK\n"
638 "@defvarx SO_PRIORITY\n"
639 "@var{value} is an integer.\n"
642 "@defvar SO_LINGER\n"
643 "@var{value} is a pair of integers @code{(@var{ENABLE}\n"
644 ". @var{TIMEOUT})}. On old systems without timeout support\n"
645 "(ie.@: without @code{struct linger}), only @var{ENABLE} has an\n"
646 "effect but the value in Guile is always a pair.\n"
649 "@c Note that we refer only to ``man ip'' here. On GNU/Linux it's\n"
650 "@c ``man 7 ip'' but on NetBSD it's ``man 4 ip''.\n"
652 "For IP level (@code{IPPROTO_IP}) the following @var{optname}s\n"
653 "are defined (when provided by the system). See @command{man\n"
654 "ip} for what they mean.\n"
656 "@defvar IP_ADD_MEMBERSHIP\n"
657 "@defvarx IP_DROP_MEMBERSHIP\n"
658 "These can be used only with @code{setsockopt}, not\n"
659 "@code{getsockopt}. @var{value} is a pair\n"
660 "@code{(@var{MULTIADDR} . @var{INTERFACEADDR})} of IPv4\n"
661 "addresses (@pxref{Network Address Conversion}).\n"
662 "@var{MULTIADDR} is a multicast address to be added to or\n"
663 "dropped from the interface @var{INTERFACEADDR}.\n"
664 "@var{INTERFACEADDR} can be @code{INADDR_ANY} to have the system\n"
665 "select the interface. @var{INTERFACEADDR} can also be an\n"
666 "interface index number, on systems supporting that.\n"
668 #define FUNC_NAME s_scm_setsockopt
673 #ifdef HAVE_STRUCT_LINGER
674 struct linger opt_linger
;
677 #if HAVE_STRUCT_IP_MREQ
678 struct ip_mreq opt_mreq
;
681 const void *optval
= NULL
;
682 socklen_t optlen
= 0;
684 int ilevel
, ioptname
;
686 sock
= SCM_COERCE_OUTPORT (sock
);
688 SCM_VALIDATE_OPFPORT (1, sock
);
689 ilevel
= scm_to_int (level
);
690 ioptname
= scm_to_int (optname
);
692 fd
= SCM_FPORT_FDES (sock
);
694 if (ilevel
== SOL_SOCKET
)
697 if (ioptname
== SO_LINGER
)
699 #ifdef HAVE_STRUCT_LINGER
700 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
701 opt_linger
.l_onoff
= scm_to_int (SCM_CAR (value
));
702 opt_linger
.l_linger
= scm_to_int (SCM_CDR (value
));
703 optlen
= sizeof (struct linger
);
704 optval
= &opt_linger
;
706 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
707 opt_int
= scm_to_int (SCM_CAR (value
));
708 /* timeout is ignored, but may as well validate it. */
709 scm_to_int (SCM_CDR (value
));
710 optlen
= sizeof (int);
718 || ioptname
== SO_SNDBUF
721 || ioptname
== SO_RCVBUF
725 opt_int
= scm_to_int (value
);
726 optlen
= sizeof (size_t);
731 #if HAVE_STRUCT_IP_MREQ
732 if (ilevel
== IPPROTO_IP
&&
733 (ioptname
== IP_ADD_MEMBERSHIP
|| ioptname
== IP_DROP_MEMBERSHIP
))
735 /* Fourth argument must be a pair of addresses. */
736 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
737 opt_mreq
.imr_multiaddr
.s_addr
= htonl (scm_to_ulong (SCM_CAR (value
)));
738 opt_mreq
.imr_interface
.s_addr
= htonl (scm_to_ulong (SCM_CDR (value
)));
739 optlen
= sizeof (opt_mreq
);
746 /* Most options take an int. */
747 opt_int
= scm_to_int (value
);
748 optlen
= sizeof (int);
752 if (setsockopt (fd
, ilevel
, ioptname
, optval
, optlen
) == -1)
754 return SCM_UNSPECIFIED
;
758 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
760 "Sockets can be closed simply by using @code{close-port}. The\n"
761 "@code{shutdown} procedure allows reception or transmission on a\n"
762 "connection to be shut down individually, according to the parameter\n"
766 "Stop receiving data for this socket. If further data arrives, reject it.\n"
768 "Stop trying to transmit data from this socket. Discard any\n"
769 "data waiting to be sent. Stop looking for acknowledgement of\n"
770 "data already sent; don't retransmit it if it is lost.\n"
772 "Stop both reception and transmission.\n"
774 "The return value is unspecified.")
775 #define FUNC_NAME s_scm_shutdown
778 sock
= SCM_COERCE_OUTPORT (sock
);
779 SCM_VALIDATE_OPFPORT (1, sock
);
780 fd
= SCM_FPORT_FDES (sock
);
781 if (shutdown (fd
, scm_to_signed_integer (how
, 0, 2)) == -1)
783 return SCM_UNSPECIFIED
;
787 /* convert fam/address/args into a sockaddr of the appropriate type.
788 args is modified by removing the arguments actually used.
789 which_arg and proc are used when reporting errors:
790 which_arg is the position of address in the original argument list.
791 proc is the name of the original procedure.
792 size returns the size of the structure allocated. */
794 static struct sockaddr
*
795 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
796 const char *proc
, size_t *size
)
797 #define FUNC_NAME proc
803 struct sockaddr_in
*soka
;
807 SCM_VALIDATE_ULONG_COPY (which_arg
, address
, addr
);
808 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
809 port
= scm_to_int (SCM_CAR (*args
));
810 *args
= SCM_CDR (*args
);
811 soka
= (struct sockaddr_in
*) scm_malloc (sizeof (struct sockaddr_in
));
813 #if HAVE_STRUCT_SOCKADDR_SIN_LEN
814 soka
->sin_len
= sizeof (struct sockaddr_in
);
816 soka
->sin_family
= AF_INET
;
817 soka
->sin_addr
.s_addr
= htonl (addr
);
818 soka
->sin_port
= htons (port
);
819 *size
= sizeof (struct sockaddr_in
);
820 return (struct sockaddr
*) soka
;
827 struct sockaddr_in6
*soka
;
828 unsigned long flowinfo
= 0;
829 unsigned long scope_id
= 0;
831 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
832 port
= scm_to_int (SCM_CAR (*args
));
833 *args
= SCM_CDR (*args
);
834 if (scm_is_pair (*args
))
836 SCM_VALIDATE_ULONG_COPY (which_arg
+ 2, SCM_CAR (*args
), flowinfo
);
837 *args
= SCM_CDR (*args
);
838 if (scm_is_pair (*args
))
840 SCM_VALIDATE_ULONG_COPY (which_arg
+ 3, SCM_CAR (*args
),
842 *args
= SCM_CDR (*args
);
845 soka
= (struct sockaddr_in6
*) scm_malloc (sizeof (struct sockaddr_in6
));
847 #if HAVE_STRUCT_SOCKADDR_IN6_SIN6_LEN
848 soka
->sin6_len
= sizeof (struct sockaddr_in6
);
850 soka
->sin6_family
= AF_INET6
;
851 scm_to_ipv6 (soka
->sin6_addr
.s6_addr
, address
);
852 soka
->sin6_port
= htons (port
);
853 soka
->sin6_flowinfo
= flowinfo
;
854 #ifdef HAVE_SIN6_SCOPE_ID
855 soka
->sin6_scope_id
= scope_id
;
857 *size
= sizeof (struct sockaddr_in6
);
858 return (struct sockaddr
*) soka
;
861 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
864 struct sockaddr_un
*soka
;
868 scm_dynwind_begin (0);
870 c_address
= scm_to_locale_string (address
);
871 scm_dynwind_free (c_address
);
873 /* the static buffer size in sockaddr_un seems to be arbitrary
874 and not necessarily a hard limit. e.g., the glibc manual
875 suggests it may be possible to declare it size 0. let's
876 ignore it. if the O/S doesn't like the size it will cause
877 connect/bind etc., to fail. sun_path is always the last
878 member of the structure. */
879 addr_size
= sizeof (struct sockaddr_un
)
880 + max (0, strlen (c_address
) + 1 - (sizeof soka
->sun_path
));
881 soka
= (struct sockaddr_un
*) scm_malloc (addr_size
);
882 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
883 soka
->sun_family
= AF_UNIX
;
884 strcpy (soka
->sun_path
, c_address
);
885 *size
= SUN_LEN (soka
);
888 return (struct sockaddr
*) soka
;
892 scm_out_of_range (proc
, scm_from_int (fam
));
897 SCM_DEFINE (scm_connect
, "connect", 2, 1, 1,
898 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
899 "Initiate a connection from a socket using a specified address\n"
900 "family to the address\n"
901 "specified by @var{address} and possibly @var{args}.\n"
902 "The format required for @var{address}\n"
903 "and @var{args} depends on the family of the socket.\n\n"
904 "For a socket of family @code{AF_UNIX},\n"
905 "only @var{address} is specified and must be a string with the\n"
906 "filename where the socket is to be created.\n\n"
907 "For a socket of family @code{AF_INET},\n"
908 "@var{address} must be an integer IPv4 host address and\n"
909 "@var{args} must be a single integer port number.\n\n"
910 "For a socket of family @code{AF_INET6},\n"
911 "@var{address} must be an integer IPv6 host address and\n"
912 "@var{args} may be up to three integers:\n"
913 "port [flowinfo] [scope_id],\n"
914 "where flowinfo and scope_id default to zero.\n\n"
915 "Alternatively, the second argument can be a socket address object "
916 "as returned by @code{make-socket-address}, in which case the "
917 "no additional arguments should be passed.\n\n"
918 "The return value is unspecified.")
919 #define FUNC_NAME s_scm_connect
922 struct sockaddr
*soka
;
925 sock
= SCM_COERCE_OUTPORT (sock
);
926 SCM_VALIDATE_OPFPORT (1, sock
);
927 fd
= SCM_FPORT_FDES (sock
);
929 if (address
== SCM_UNDEFINED
)
930 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
931 `socket address' object. */
932 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
934 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
935 &args
, 3, FUNC_NAME
, &size
);
937 if (connect (fd
, soka
, size
) == -1)
939 int save_errno
= errno
;
946 return SCM_UNSPECIFIED
;
950 SCM_DEFINE (scm_bind
, "bind", 2, 1, 1,
951 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
952 "Assign an address to the socket port @var{sock}.\n"
953 "Generally this only needs to be done for server sockets,\n"
954 "so they know where to look for incoming connections. A socket\n"
955 "without an address will be assigned one automatically when it\n"
956 "starts communicating.\n\n"
957 "The format of @var{address} and @var{args} depends\n"
958 "on the family of the socket.\n\n"
959 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
960 "is specified and must be a string with the filename where\n"
961 "the socket is to be created.\n\n"
962 "For a socket of family @code{AF_INET}, @var{address}\n"
963 "must be an integer IPv4 address and @var{args}\n"
964 "must be a single integer port number.\n\n"
965 "The values of the following variables can also be used for\n"
967 "@defvar INADDR_ANY\n"
968 "Allow connections from any address.\n"
970 "@defvar INADDR_LOOPBACK\n"
971 "The address of the local host using the loopback device.\n"
973 "@defvar INADDR_BROADCAST\n"
974 "The broadcast address on the local network.\n"
976 "@defvar INADDR_NONE\n"
979 "For a socket of family @code{AF_INET6}, @var{address}\n"
980 "must be an integer IPv6 address and @var{args}\n"
981 "may be up to three integers:\n"
982 "port [flowinfo] [scope_id],\n"
983 "where flowinfo and scope_id default to zero.\n\n"
984 "Alternatively, the second argument can be a socket address object "
985 "as returned by @code{make-socket-address}, in which case the "
986 "no additional arguments should be passed.\n\n"
987 "The return value is unspecified.")
988 #define FUNC_NAME s_scm_bind
990 struct sockaddr
*soka
;
994 sock
= SCM_COERCE_OUTPORT (sock
);
995 SCM_VALIDATE_OPFPORT (1, sock
);
996 fd
= SCM_FPORT_FDES (sock
);
998 if (address
== SCM_UNDEFINED
)
999 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
1000 `socket address' object. */
1001 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
1003 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
1004 &args
, 3, FUNC_NAME
, &size
);
1007 if (bind (fd
, soka
, size
) == -1)
1009 int save_errno
= errno
;
1016 return SCM_UNSPECIFIED
;
1020 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
1021 (SCM sock
, SCM backlog
),
1022 "Enable @var{sock} to accept connection\n"
1023 "requests. @var{backlog} is an integer specifying\n"
1024 "the maximum length of the queue for pending connections.\n"
1025 "If the queue fills, new clients will fail to connect until\n"
1026 "the server calls @code{accept} to accept a connection from\n"
1028 "The return value is unspecified.")
1029 #define FUNC_NAME s_scm_listen
1032 sock
= SCM_COERCE_OUTPORT (sock
);
1033 SCM_VALIDATE_OPFPORT (1, sock
);
1034 fd
= SCM_FPORT_FDES (sock
);
1035 if (listen (fd
, scm_to_int (backlog
)) == -1)
1037 return SCM_UNSPECIFIED
;
1041 /* Put the components of a sockaddr into a new SCM vector. */
1042 static SCM_C_INLINE_KEYWORD SCM
1043 _scm_from_sockaddr (const scm_t_max_sockaddr
*address
, unsigned addr_size
,
1046 SCM result
= SCM_EOL
;
1047 short int fam
= ((struct sockaddr
*) address
)->sa_family
;
1053 const struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
1055 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
1057 SCM_SIMPLE_VECTOR_SET(result
, 0,
1058 scm_from_short (fam
));
1059 SCM_SIMPLE_VECTOR_SET(result
, 1,
1060 scm_from_ulong (ntohl (nad
->sin_addr
.s_addr
)));
1061 SCM_SIMPLE_VECTOR_SET(result
, 2,
1062 scm_from_ushort (ntohs (nad
->sin_port
)));
1068 const struct sockaddr_in6
*nad
= (struct sockaddr_in6
*) address
;
1070 result
= scm_c_make_vector (5, SCM_UNSPECIFIED
);
1071 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1072 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_ipv6 (nad
->sin6_addr
.s6_addr
));
1073 SCM_SIMPLE_VECTOR_SET(result
, 2, scm_from_ushort (ntohs (nad
->sin6_port
)));
1074 SCM_SIMPLE_VECTOR_SET(result
, 3, scm_from_uint32 (nad
->sin6_flowinfo
));
1075 #ifdef HAVE_SIN6_SCOPE_ID
1076 SCM_SIMPLE_VECTOR_SET(result
, 4, scm_from_ulong (nad
->sin6_scope_id
));
1078 SCM_SIMPLE_VECTOR_SET(result
, 4, SCM_INUM0
);
1083 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1086 const struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
1088 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
1090 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1091 /* When addr_size is not enough to cover sun_path, do not try
1093 if (addr_size
<= offsetof (struct sockaddr_un
, sun_path
))
1094 SCM_SIMPLE_VECTOR_SET(result
, 1, SCM_BOOL_F
);
1096 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_locale_string (nad
->sun_path
));
1101 result
= SCM_UNSPECIFIED
;
1102 scm_misc_error (proc
, "unrecognised address family: ~A",
1103 scm_list_1 (scm_from_int (fam
)));
1109 /* The publicly-visible function. Return a Scheme object representing
1110 ADDRESS, an address of ADDR_SIZE bytes. */
1112 scm_from_sockaddr (const struct sockaddr
*address
, unsigned addr_size
)
1114 return (_scm_from_sockaddr ((scm_t_max_sockaddr
*) address
,
1115 addr_size
, "scm_from_sockaddr"));
1118 /* Convert ADDRESS, an address object returned by either
1119 `scm_from_sockaddr ()' or `scm_make_socket_address ()', into its C
1120 representation. On success, a non-NULL pointer is returned and
1121 ADDRESS_SIZE is updated to the actual size (in bytes) of the returned
1122 address. The result must eventually be freed using `free ()'. */
1124 scm_to_sockaddr (SCM address
, size_t *address_size
)
1125 #define FUNC_NAME "scm_to_sockaddr"
1128 struct sockaddr
*c_address
= NULL
;
1130 SCM_VALIDATE_VECTOR (1, address
);
1133 family
= scm_to_short (SCM_SIMPLE_VECTOR_REF (address
, 0));
1139 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 3)
1140 scm_misc_error (FUNC_NAME
,
1141 "invalid inet address representation: ~A",
1142 scm_list_1 (address
));
1145 struct sockaddr_in c_inet
;
1147 c_inet
.sin_addr
.s_addr
=
1148 htonl (scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 1)));
1150 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1151 c_inet
.sin_family
= AF_INET
;
1153 *address_size
= sizeof (c_inet
);
1154 c_address
= scm_malloc (sizeof (c_inet
));
1155 memcpy (c_address
, &c_inet
, sizeof (c_inet
));
1164 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 5)
1165 scm_misc_error (FUNC_NAME
, "invalid inet6 address representation: ~A",
1166 scm_list_1 (address
));
1169 struct sockaddr_in6 c_inet6
;
1171 scm_to_ipv6 (c_inet6
.sin6_addr
.s6_addr
, address
);
1173 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1174 c_inet6
.sin6_flowinfo
=
1175 scm_to_uint32 (SCM_SIMPLE_VECTOR_REF (address
, 3));
1176 #ifdef HAVE_SIN6_SCOPE_ID
1177 c_inet6
.sin6_scope_id
=
1178 scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 4));
1181 c_inet6
.sin6_family
= AF_INET6
;
1183 *address_size
= sizeof (c_inet6
);
1184 c_address
= scm_malloc (sizeof (c_inet6
));
1185 memcpy (c_address
, &c_inet6
, sizeof (c_inet6
));
1192 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1195 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 2)
1196 scm_misc_error (FUNC_NAME
, "invalid unix address representation: ~A",
1197 scm_list_1 (address
));
1201 size_t path_len
= 0;
1203 path
= SCM_SIMPLE_VECTOR_REF (address
, 1);
1204 if ((!scm_is_string (path
)) && (path
!= SCM_BOOL_F
))
1205 scm_misc_error (FUNC_NAME
, "invalid unix address "
1206 "path: ~A", scm_list_1 (path
));
1209 struct sockaddr_un c_unix
;
1211 if (path
== SCM_BOOL_F
)
1214 path_len
= scm_c_string_length (path
);
1216 #ifdef UNIX_PATH_MAX
1217 if (path_len
>= UNIX_PATH_MAX
)
1219 /* We can hope that this limit will eventually vanish, at least on GNU.
1220 However, currently, while glibc doesn't define `UNIX_PATH_MAX', it
1221 documents it has being limited to 108 bytes. */
1222 if (path_len
>= sizeof (c_unix
.sun_path
))
1224 scm_misc_error (FUNC_NAME
, "unix address path "
1225 "too long: ~A", scm_list_1 (path
));
1230 scm_to_locale_stringbuf (path
, c_unix
.sun_path
,
1231 #ifdef UNIX_PATH_MAX
1234 sizeof (c_unix
.sun_path
));
1236 c_unix
.sun_path
[path_len
] = '\0';
1239 if (strlen (c_unix
.sun_path
) != path_len
)
1240 scm_misc_error (FUNC_NAME
, "unix address path "
1241 "contains nul characters: ~A",
1245 c_unix
.sun_path
[0] = '\0';
1247 c_unix
.sun_family
= AF_UNIX
;
1249 *address_size
= SUN_LEN (&c_unix
);
1250 c_address
= scm_malloc (sizeof (c_unix
));
1251 memcpy (c_address
, &c_unix
, sizeof (c_unix
));
1261 scm_misc_error (FUNC_NAME
, "unrecognised address family: ~A",
1262 scm_list_1 (scm_from_ushort (family
)));
1270 /* Return a newly-allocated `sockaddr' structure that reflects ADDRESS, being
1271 an address of family FAMILY, with the family-specific parameters ARGS (see
1272 the description of `connect' for details). The returned structure may be
1273 freed using `free ()'. */
1275 scm_c_make_socket_address (SCM family
, SCM address
, SCM args
,
1276 size_t *address_size
)
1278 struct sockaddr
*soka
;
1280 soka
= scm_fill_sockaddr (scm_to_ushort (family
), address
, &args
, 1,
1281 "scm_c_make_socket_address", address_size
);
1286 SCM_DEFINE (scm_make_socket_address
, "make-socket-address", 2, 0, 1,
1287 (SCM family
, SCM address
, SCM args
),
1288 "Return a Scheme address object that reflects @var{address}, "
1289 "being an address of family @var{family}, with the "
1290 "family-specific parameters @var{args} (see the description of "
1291 "@code{connect} for details).")
1292 #define FUNC_NAME s_scm_make_socket_address
1294 SCM result
= SCM_BOOL_F
;
1295 struct sockaddr
*c_address
;
1296 size_t c_address_size
;
1298 c_address
= scm_c_make_socket_address (family
, address
, args
,
1300 if (c_address
!= NULL
)
1302 result
= scm_from_sockaddr (c_address
, c_address_size
);
1311 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
1313 "Accept a connection on a bound, listening socket.\n"
1315 "are no pending connections in the queue, wait until\n"
1316 "one is available unless the non-blocking option has been\n"
1317 "set on the socket.\n\n"
1318 "The return value is a\n"
1319 "pair in which the @emph{car} is a new socket port for the\n"
1321 "the @emph{cdr} is an object with address information about the\n"
1322 "client which initiated the connection.\n\n"
1323 "@var{sock} does not become part of the\n"
1324 "connection and will continue to accept new requests.")
1325 #define FUNC_NAME s_scm_accept
1331 SELECT_TYPE readfds
, exceptfds
;
1332 socklen_t addr_size
= MAX_ADDR_SIZE
;
1333 scm_t_max_sockaddr addr
;
1335 sock
= SCM_COERCE_OUTPORT (sock
);
1336 SCM_VALIDATE_OPFPORT (1, sock
);
1337 fd
= SCM_FPORT_FDES (sock
);
1340 FD_ZERO (&exceptfds
);
1341 FD_SET (fd
, &readfds
);
1342 FD_SET (fd
, &exceptfds
);
1344 /* Block until something happens on FD, leaving guile mode while
1346 selected
= scm_std_select (fd
+ 1, &readfds
, NULL
, &exceptfds
,
1351 newfd
= accept (fd
, (struct sockaddr
*) &addr
, &addr_size
);
1354 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
1355 address
= _scm_from_sockaddr (&addr
, addr_size
,
1358 return scm_cons (newsock
, address
);
1362 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
1364 "Return the address of @var{sock}, in the same form as the\n"
1365 "object returned by @code{accept}. On many systems the address\n"
1366 "of a socket in the @code{AF_FILE} namespace cannot be read.")
1367 #define FUNC_NAME s_scm_getsockname
1370 socklen_t addr_size
= MAX_ADDR_SIZE
;
1371 scm_t_max_sockaddr addr
;
1373 sock
= SCM_COERCE_OUTPORT (sock
);
1374 SCM_VALIDATE_OPFPORT (1, sock
);
1375 fd
= SCM_FPORT_FDES (sock
);
1376 if (getsockname (fd
, (struct sockaddr
*) &addr
, &addr_size
) == -1)
1379 return _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1383 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
1385 "Return the address that @var{sock}\n"
1386 "is connected to, in the same form as the object returned by\n"
1387 "@code{accept}. On many systems the address of a socket in the\n"
1388 "@code{AF_FILE} namespace cannot be read.")
1389 #define FUNC_NAME s_scm_getpeername
1392 socklen_t addr_size
= MAX_ADDR_SIZE
;
1393 scm_t_max_sockaddr addr
;
1395 sock
= SCM_COERCE_OUTPORT (sock
);
1396 SCM_VALIDATE_OPFPORT (1, sock
);
1397 fd
= SCM_FPORT_FDES (sock
);
1398 if (getpeername (fd
, (struct sockaddr
*) &addr
, &addr_size
) == -1)
1401 return _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1405 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
1406 (SCM sock
, SCM buf
, SCM flags
),
1407 "Receive data from a socket port.\n"
1408 "@var{sock} must already\n"
1409 "be bound to the address from which data is to be received.\n"
1410 "@var{buf} is a string into which\n"
1411 "the data will be written. The size of @var{buf} limits\n"
1413 "data which can be received: in the case of packet\n"
1414 "protocols, if a packet larger than this limit is encountered\n"
1416 "will be irrevocably lost.\n\n"
1417 "The optional @var{flags} argument is a value or\n"
1418 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1419 "The value returned is the number of bytes read from the\n"
1421 "Note that the data is read directly from the socket file\n"
1423 "any unread buffered port data is ignored.")
1424 #define FUNC_NAME s_scm_recv
1432 SCM_VALIDATE_OPFPORT (1, sock
);
1433 SCM_VALIDATE_STRING (2, buf
);
1434 if (SCM_UNBNDP (flags
))
1437 flg
= scm_to_int (flags
);
1438 fd
= SCM_FPORT_FDES (sock
);
1440 len
= scm_i_string_length (buf
);
1441 buf
= scm_i_string_start_writing (buf
);
1442 dest
= scm_i_string_writable_chars (buf
);
1443 SCM_SYSCALL (rv
= recv (fd
, dest
, len
, flg
));
1444 scm_i_string_stop_writing ();
1449 scm_remember_upto_here_1 (buf
);
1450 return scm_from_int (rv
);
1454 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
1455 (SCM sock
, SCM message
, SCM flags
),
1456 "Transmit the string @var{message} on a socket port @var{sock}.\n"
1457 "@var{sock} must already be bound to a destination address. The\n"
1458 "value returned is the number of bytes transmitted --\n"
1459 "it's possible for\n"
1460 "this to be less than the length of @var{message}\n"
1461 "if the socket is\n"
1462 "set to be non-blocking. The optional @var{flags} argument\n"
1464 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1465 "Note that the data is written directly to the socket\n"
1466 "file descriptor:\n"
1467 "any unflushed buffered port data is ignored.")
1468 #define FUNC_NAME s_scm_send
1476 sock
= SCM_COERCE_OUTPORT (sock
);
1477 SCM_VALIDATE_OPFPORT (1, sock
);
1478 SCM_VALIDATE_STRING (2, message
);
1479 if (SCM_UNBNDP (flags
))
1482 flg
= scm_to_int (flags
);
1483 fd
= SCM_FPORT_FDES (sock
);
1485 len
= scm_i_string_length (message
);
1486 message
= scm_i_string_start_writing (message
);
1487 src
= scm_i_string_writable_chars (message
);
1488 SCM_SYSCALL (rv
= send (fd
, src
, len
, flg
));
1489 scm_i_string_stop_writing ();
1494 scm_remember_upto_here_1 (message
);
1495 return scm_from_int (rv
);
1499 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
1500 (SCM sock
, SCM str
, SCM flags
, SCM start
, SCM end
),
1501 "Receive data from socket port @var{sock} (which must be already\n"
1502 "bound), returning the originating address as well as the data.\n"
1503 "This is usually for use on datagram sockets, but can be used on\n"
1504 "stream-oriented sockets too.\n"
1506 "The data received is stored in the given @var{str}, using\n"
1507 "either the whole string or just the region between the optional\n"
1508 "@var{start} and @var{end} positions. The size of @var{str}\n"
1509 "limits the amount of data which can be received. For datagram\n"
1510 "protocols, if a packet larger than this is received then excess\n"
1511 "bytes are irrevocably lost.\n"
1513 "The return value is a pair. The @code{car} is the number of\n"
1514 "bytes read. The @code{cdr} is a socket address object which is\n"
1515 "where the data come from, or @code{#f} if the origin is\n"
1518 "The optional @var{flags} argument is a or bitwise OR\n"
1519 "(@code{logior}) of @code{MSG_OOB}, @code{MSG_PEEK},\n"
1520 "@code{MSG_DONTROUTE} etc.\n"
1522 "Data is read directly from the socket file descriptor, any\n"
1523 "buffered port data is ignored.\n"
1525 "On a GNU/Linux system @code{recvfrom!} is not multi-threading,\n"
1526 "all threads stop while a @code{recvfrom!} call is in progress.\n"
1527 "An application may need to use @code{select}, @code{O_NONBLOCK}\n"
1528 "or @code{MSG_DONTWAIT} to avoid this.")
1529 #define FUNC_NAME s_scm_recvfrom
1538 socklen_t addr_size
= MAX_ADDR_SIZE
;
1539 scm_t_max_sockaddr addr
;
1541 SCM_VALIDATE_OPFPORT (1, sock
);
1542 fd
= SCM_FPORT_FDES (sock
);
1544 SCM_VALIDATE_STRING (2, str
);
1545 scm_i_get_substring_spec (scm_i_string_length (str
),
1546 start
, &offset
, end
, &cend
);
1548 if (SCM_UNBNDP (flags
))
1551 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
1553 /* recvfrom will not necessarily return an address. usually nothing
1554 is returned for stream sockets. */
1555 str
= scm_i_string_start_writing (str
);
1556 buf
= scm_i_string_writable_chars (str
);
1557 ((struct sockaddr
*) &addr
)->sa_family
= AF_UNSPEC
;
1558 SCM_SYSCALL (rv
= recvfrom (fd
, buf
+ offset
,
1560 (struct sockaddr
*) &addr
, &addr_size
));
1561 scm_i_string_stop_writing ();
1565 if (((struct sockaddr
*) &addr
)->sa_family
!= AF_UNSPEC
)
1566 address
= _scm_from_sockaddr (&addr
, addr_size
, FUNC_NAME
);
1568 address
= SCM_BOOL_F
;
1570 scm_remember_upto_here_1 (str
);
1572 return scm_cons (scm_from_int (rv
), address
);
1576 SCM_DEFINE (scm_sendto
, "sendto", 3, 1, 1,
1577 (SCM sock
, SCM message
, SCM fam_or_sockaddr
, SCM address
, SCM args_and_flags
),
1578 "Transmit the string @var{message} on the socket port\n"
1580 "destination address is specified using the @var{fam},\n"
1581 "@var{address} and\n"
1582 "@var{args_and_flags} arguments, or just a socket address object "
1583 "returned by @code{make-socket-address}, in a similar way to the\n"
1584 "@code{connect} procedure. @var{args_and_flags} contains\n"
1585 "the usual connection arguments optionally followed by\n"
1586 "a flags argument, which is a value or\n"
1587 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1588 "The value returned is the number of bytes transmitted --\n"
1589 "it's possible for\n"
1590 "this to be less than the length of @var{message} if the\n"
1592 "set to be non-blocking.\n"
1593 "Note that the data is written directly to the socket\n"
1594 "file descriptor:\n"
1595 "any unflushed buffered port data is ignored.")
1596 #define FUNC_NAME s_scm_sendto
1601 struct sockaddr
*soka
;
1604 sock
= SCM_COERCE_OUTPORT (sock
);
1605 SCM_VALIDATE_FPORT (1, sock
);
1606 SCM_VALIDATE_STRING (2, message
);
1607 fd
= SCM_FPORT_FDES (sock
);
1609 if (!scm_is_number (fam_or_sockaddr
))
1611 /* FAM_OR_SOCKADDR must actually be a `socket address' object. This
1612 means that the following arguments, i.e. ADDRESS and those listed in
1613 ARGS_AND_FLAGS, are the `MSG_' flags. */
1614 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
1615 if (address
!= SCM_UNDEFINED
)
1616 args_and_flags
= scm_cons (address
, args_and_flags
);
1619 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
1620 &args_and_flags
, 3, FUNC_NAME
, &size
);
1622 if (scm_is_null (args_and_flags
))
1626 SCM_VALIDATE_CONS (5, args_and_flags
);
1627 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
1629 SCM_SYSCALL (rv
= sendto (fd
,
1630 scm_i_string_chars (message
),
1631 scm_i_string_length (message
),
1635 int save_errno
= errno
;
1642 scm_remember_upto_here_1 (message
);
1643 return scm_from_int (rv
);
1652 /* protocol families. */
1654 scm_c_define ("AF_UNSPEC", scm_from_int (AF_UNSPEC
));
1657 scm_c_define ("AF_UNIX", scm_from_int (AF_UNIX
));
1660 scm_c_define ("AF_INET", scm_from_int (AF_INET
));
1663 scm_c_define ("AF_INET6", scm_from_int (AF_INET6
));
1667 scm_c_define ("PF_UNSPEC", scm_from_int (PF_UNSPEC
));
1670 scm_c_define ("PF_UNIX", scm_from_int (PF_UNIX
));
1673 scm_c_define ("PF_INET", scm_from_int (PF_INET
));
1676 scm_c_define ("PF_INET6", scm_from_int (PF_INET6
));
1679 /* standard addresses. */
1681 scm_c_define ("INADDR_ANY", scm_from_ulong (INADDR_ANY
));
1683 #ifdef INADDR_BROADCAST
1684 scm_c_define ("INADDR_BROADCAST", scm_from_ulong (INADDR_BROADCAST
));
1687 scm_c_define ("INADDR_NONE", scm_from_ulong (INADDR_NONE
));
1689 #ifdef INADDR_LOOPBACK
1690 scm_c_define ("INADDR_LOOPBACK", scm_from_ulong (INADDR_LOOPBACK
));
1695 SOCK_PACKET is deliberately omitted, the GNU/Linux socket(2) and
1696 packet(7) advise that it's obsolete and strongly deprecated. */
1699 scm_c_define ("SOCK_STREAM", scm_from_int (SOCK_STREAM
));
1702 scm_c_define ("SOCK_DGRAM", scm_from_int (SOCK_DGRAM
));
1704 #ifdef SOCK_SEQPACKET
1705 scm_c_define ("SOCK_SEQPACKET", scm_from_int (SOCK_SEQPACKET
));
1708 scm_c_define ("SOCK_RAW", scm_from_int (SOCK_RAW
));
1711 scm_c_define ("SOCK_RDM", scm_from_int (SOCK_RDM
));
1714 /* setsockopt level.
1716 SOL_IP, SOL_TCP and SOL_UDP are defined on gnu/linux, but not on for
1717 instance NetBSD. We define IPPROTOs because that's what the posix spec
1718 shows in its example at
1720 http://www.opengroup.org/onlinepubs/007904975/functions/getsockopt.html
1723 scm_c_define ("SOL_SOCKET", scm_from_int (SOL_SOCKET
));
1726 scm_c_define ("IPPROTO_IP", scm_from_int (IPPROTO_IP
));
1729 scm_c_define ("IPPROTO_TCP", scm_from_int (IPPROTO_TCP
));
1732 scm_c_define ("IPPROTO_UDP", scm_from_int (IPPROTO_UDP
));
1735 /* setsockopt names. */
1737 scm_c_define ("SO_DEBUG", scm_from_int (SO_DEBUG
));
1740 scm_c_define ("SO_REUSEADDR", scm_from_int (SO_REUSEADDR
));
1743 scm_c_define ("SO_STYLE", scm_from_int (SO_STYLE
));
1746 scm_c_define ("SO_TYPE", scm_from_int (SO_TYPE
));
1749 scm_c_define ("SO_ERROR", scm_from_int (SO_ERROR
));
1752 scm_c_define ("SO_DONTROUTE", scm_from_int (SO_DONTROUTE
));
1755 scm_c_define ("SO_BROADCAST", scm_from_int (SO_BROADCAST
));
1758 scm_c_define ("SO_SNDBUF", scm_from_int (SO_SNDBUF
));
1761 scm_c_define ("SO_RCVBUF", scm_from_int (SO_RCVBUF
));
1764 scm_c_define ("SO_KEEPALIVE", scm_from_int (SO_KEEPALIVE
));
1767 scm_c_define ("SO_OOBINLINE", scm_from_int (SO_OOBINLINE
));
1770 scm_c_define ("SO_NO_CHECK", scm_from_int (SO_NO_CHECK
));
1773 scm_c_define ("SO_PRIORITY", scm_from_int (SO_PRIORITY
));
1776 scm_c_define ("SO_LINGER", scm_from_int (SO_LINGER
));
1779 /* recv/send options. */
1781 scm_c_define ("MSG_DONTWAIT", scm_from_int (MSG_DONTWAIT
));
1784 scm_c_define ("MSG_OOB", scm_from_int (MSG_OOB
));
1787 scm_c_define ("MSG_PEEK", scm_from_int (MSG_PEEK
));
1789 #ifdef MSG_DONTROUTE
1790 scm_c_define ("MSG_DONTROUTE", scm_from_int (MSG_DONTROUTE
));
1794 scm_i_init_socket_Win32 ();
1797 #ifdef IP_ADD_MEMBERSHIP
1798 scm_c_define ("IP_ADD_MEMBERSHIP", scm_from_int (IP_ADD_MEMBERSHIP
));
1799 scm_c_define ("IP_DROP_MEMBERSHIP", scm_from_int (IP_DROP_MEMBERSHIP
));
1802 scm_add_feature ("socket");
1804 #include "libguile/socket.x"