1 /* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004 Free Software Foundation, Inc.
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public
5 * License as published by the Free Software Foundation; either
6 * version 2.1 of the License, or (at your option) any later version.
8 * This library is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
28 #include "libguile/_scm.h"
29 #include "libguile/unif.h"
30 #include "libguile/feature.h"
31 #include "libguile/fports.h"
32 #include "libguile/strings.h"
33 #include "libguile/vectors.h"
34 #include "libguile/dynwind.h"
36 #include "libguile/validate.h"
37 #include "libguile/socket.h"
40 #include "win32-socket.h"
52 #include <sys/types.h>
53 #ifdef HAVE_WINSOCK2_H
56 #include <sys/socket.h>
57 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
60 #include <netinet/in.h>
62 #include <arpa/inet.h>
65 #if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
66 #define SUN_LEN(ptr) ((size_t) (((struct sockaddr_un *) 0)->sun_path) \
67 + strlen ((ptr)->sun_path))
72 SCM_DEFINE (scm_htons
, "htons", 1, 0, 0,
74 "Convert a 16 bit quantity from host to network byte ordering.\n"
75 "@var{value} is packed into 2 bytes, which are then converted\n"
76 "and returned as a new integer.")
77 #define FUNC_NAME s_scm_htons
79 return scm_from_ushort (htons (scm_to_ushort (value
)));
83 SCM_DEFINE (scm_ntohs
, "ntohs", 1, 0, 0,
85 "Convert a 16 bit quantity from network to host byte ordering.\n"
86 "@var{value} is packed into 2 bytes, which are then converted\n"
87 "and returned as a new integer.")
88 #define FUNC_NAME s_scm_ntohs
90 return scm_from_ushort (ntohs (scm_to_ushort (value
)));
94 SCM_DEFINE (scm_htonl
, "htonl", 1, 0, 0,
96 "Convert a 32 bit quantity from host to network byte ordering.\n"
97 "@var{value} is packed into 4 bytes, which are then converted\n"
98 "and returned as a new integer.")
99 #define FUNC_NAME s_scm_htonl
101 scm_t_uint32 c_in
= SCM_NUM2ULONG (1, value
);
103 return scm_from_ulong (htonl (c_in
));
107 SCM_DEFINE (scm_ntohl
, "ntohl", 1, 0, 0,
109 "Convert a 32 bit quantity from network to host byte ordering.\n"
110 "@var{value} is packed into 4 bytes, which are then converted\n"
111 "and returned as a new integer.")
112 #define FUNC_NAME s_scm_ntohl
114 scm_t_uint32 c_in
= SCM_NUM2ULONG (1, value
);
116 return scm_from_ulong (ntohl (c_in
));
120 #ifndef HAVE_INET_ATON
121 /* for our definition in inet_aton.c, not usually needed. */
122 extern int inet_aton ();
125 SCM_DEFINE (scm_inet_aton
, "inet-aton", 1, 0, 0,
127 "Convert an IPv4 Internet address from printable string\n"
128 "(dotted decimal notation) to an integer. E.g.,\n\n"
130 "(inet-aton \"127.0.0.1\") @result{} 2130706433\n"
132 #define FUNC_NAME s_scm_inet_aton
138 c_address
= scm_to_locale_string (address
);
139 rv
= inet_aton (c_address
, &soka
);
142 SCM_MISC_ERROR ("bad address", SCM_EOL
);
143 return scm_from_ulong (ntohl (soka
.s_addr
));
148 SCM_DEFINE (scm_inet_ntoa
, "inet-ntoa", 1, 0, 0,
150 "Convert an IPv4 Internet address to a printable\n"
151 "(dotted decimal notation) string. E.g.,\n\n"
153 "(inet-ntoa 2130706433) @result{} \"127.0.0.1\"\n"
155 #define FUNC_NAME s_scm_inet_ntoa
160 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, inetid
));
161 s
= inet_ntoa (addr
);
162 answer
= scm_from_locale_string (s
);
167 #ifdef HAVE_INET_NETOF
168 SCM_DEFINE (scm_inet_netof
, "inet-netof", 1, 0, 0,
170 "Return the network number part of the given IPv4\n"
171 "Internet address. E.g.,\n\n"
173 "(inet-netof 2130706433) @result{} 127\n"
175 #define FUNC_NAME s_scm_inet_netof
178 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
179 return scm_from_ulong (inet_netof (addr
));
184 #ifdef HAVE_INET_LNAOF
185 SCM_DEFINE (scm_lnaof
, "inet-lnaof", 1, 0, 0,
187 "Return the local-address-with-network part of the given\n"
188 "IPv4 Internet address, using the obsolete class A/B/C system.\n"
191 "(inet-lnaof 2130706433) @result{} 1\n"
193 #define FUNC_NAME s_scm_lnaof
196 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
197 return scm_from_ulong (inet_lnaof (addr
));
202 #ifdef HAVE_INET_MAKEADDR
203 SCM_DEFINE (scm_inet_makeaddr
, "inet-makeaddr", 2, 0, 0,
205 "Make an IPv4 Internet address by combining the network number\n"
206 "@var{net} with the local-address-within-network number\n"
207 "@var{lna}. E.g.,\n\n"
209 "(inet-makeaddr 127 1) @result{} 2130706433\n"
211 #define FUNC_NAME s_scm_inet_makeaddr
214 unsigned long netnum
;
215 unsigned long lnanum
;
217 netnum
= SCM_NUM2ULONG (1, net
);
218 lnanum
= SCM_NUM2ULONG (2, lna
);
219 addr
= inet_makeaddr (netnum
, lnanum
);
220 return scm_from_ulong (ntohl (addr
.s_addr
));
227 /* flip a 128 bit IPv6 address between host and network order. */
228 #ifdef WORDS_BIGENDIAN
229 #define FLIP_NET_HOST_128(addr)
231 #define FLIP_NET_HOST_128(addr)\
235 for (i = 0; i < 8; i++)\
237 scm_t_uint8 c = (addr)[i];\
239 (addr)[i] = (addr)[15 - i];\
245 #ifdef WORDS_BIGENDIAN
246 #define FLIPCPY_NET_HOST_128(dest, src) memcpy (dest, src, 16)
248 #define FLIPCPY_NET_HOST_128(dest, src) \
250 const scm_t_uint8 *tmp_srcp = (src) + 15; \
251 scm_t_uint8 *tmp_destp = (dest); \
254 *tmp_destp++ = *tmp_srcp--; \
255 } while (tmp_srcp != (src)); \
260 #if (SIZEOF_SCM_T_BITS * SCM_CHAR_BIT) > 128
261 #error "Assumption that scm_t_bits <= 128 bits has been violated."
264 #if (SIZEOF_UNSIGNED_LONG * SCM_CHAR_BIT) > 128
265 #error "Assumption that unsigned long <= 128 bits has been violated."
268 #if (SIZEOF_UNSIGNED_LONG_LONG * SCM_CHAR_BIT) > 128
269 #error "Assumption that unsigned long long <= 128 bits has been violated."
272 /* convert a 128 bit IPv6 address in network order to a host ordered
275 scm_from_ipv6 (const scm_t_uint8
*src
)
277 SCM result
= scm_i_mkbig ();
278 mpz_import (SCM_I_BIG_MPZ (result
),
280 1, /* big-endian chunk ordering */
281 16, /* chunks are 16 bytes long */
282 1, /* big-endian byte ordering */
283 0, /* "nails" -- leading unused bits per chunk */
285 return scm_i_normbig (result
);
288 /* convert a host ordered SCM integer to a 128 bit IPv6 address in
291 scm_to_ipv6 (scm_t_uint8 dst
[16], SCM src
)
293 if (SCM_I_INUMP (src
))
295 scm_t_signed_bits n
= SCM_I_INUM (src
);
297 scm_out_of_range (NULL
, src
);
298 #ifdef WORDS_BIGENDIAN
299 memset (dst
, 0, 16 - sizeof (scm_t_signed_bits
));
300 memcpy (dst
+ (16 - sizeof (scm_t_signed_bits
)),
302 sizeof (scm_t_signed_bits
));
304 memset (dst
+ sizeof (scm_t_signed_bits
),
306 16 - sizeof (scm_t_signed_bits
));
307 /* FIXME: this pair of ops is kinda wasteful -- should rewrite as
308 a single loop perhaps, similar to the handling of bignums. */
309 memcpy (dst
, &n
, sizeof (scm_t_signed_bits
));
310 FLIP_NET_HOST_128 (dst
);
313 else if (SCM_BIGP (src
))
317 if ((mpz_sgn (SCM_I_BIG_MPZ (src
)) < 0)
318 || mpz_sizeinbase (SCM_I_BIG_MPZ (src
), 2) > 128)
319 scm_out_of_range (NULL
, src
);
324 1, /* big-endian chunk ordering */
325 16, /* chunks are 16 bytes long */
326 1, /* big-endian byte ordering */
327 0, /* "nails" -- leading unused bits per chunk */
328 SCM_I_BIG_MPZ (src
));
329 scm_remember_upto_here_1 (src
);
332 scm_wrong_type_arg (NULL
, 0, src
);
335 #ifdef HAVE_INET_PTON
336 SCM_DEFINE (scm_inet_pton
, "inet-pton", 2, 0, 0,
337 (SCM family
, SCM address
),
338 "Convert a string containing a printable network address to\n"
339 "an integer address. Note that unlike the C version of this\n"
341 "the result is an integer with normal host byte ordering.\n"
342 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
344 "(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
345 "(inet-pton AF_INET6 \"::1\") @result{} 1\n"
347 #define FUNC_NAME s_scm_inet_pton
354 af
= scm_to_int (family
);
355 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
356 src
= scm_to_locale_string (address
);
357 rv
= inet_pton (af
, src
, dst
);
364 SCM_MISC_ERROR ("Bad address", SCM_EOL
);
366 return scm_from_ulong (ntohl (*(scm_t_uint32
*) dst
));
368 return scm_from_ipv6 ((char *) dst
);
373 #ifdef HAVE_INET_NTOP
374 SCM_DEFINE (scm_inet_ntop
, "inet-ntop", 2, 0, 0,
375 (SCM family
, SCM address
),
376 "Convert a network address into a printable string.\n"
377 "Note that unlike the C version of this function,\n"
378 "the input is an integer with normal host byte ordering.\n"
379 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
381 "(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
382 "(inet-ntop AF_INET6 (- (expt 2 128) 1)) @result{}\n"
383 "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\n"
385 #define FUNC_NAME s_scm_inet_ntop
388 #ifdef INET6_ADDRSTRLEN
389 char dst
[INET6_ADDRSTRLEN
];
395 af
= scm_to_int (family
);
396 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
398 *(scm_t_uint32
*) addr6
= htonl (SCM_NUM2ULONG (2, address
));
400 scm_to_ipv6 (addr6
, address
);
401 if (inet_ntop (af
, &addr6
, dst
, sizeof dst
) == NULL
)
403 return scm_from_locale_string (dst
);
408 #endif /* HAVE_IPV6 */
410 SCM_SYMBOL (sym_socket
, "socket");
412 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
414 SCM_DEFINE (scm_socket
, "socket", 3, 0, 0,
415 (SCM family
, SCM style
, SCM proto
),
416 "Return a new socket port of the type specified by @var{family},\n"
417 "@var{style} and @var{proto}. All three parameters are\n"
418 "integers. Supported values for @var{family} are\n"
419 "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
420 "Typical values for @var{style} are @code{SOCK_STREAM},\n"
421 "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
422 "@var{proto} can be obtained from a protocol name using\n"
423 "@code{getprotobyname}. A value of zero specifies the default\n"
424 "protocol, which is usually right.\n\n"
425 "A single socket port cannot by used for communication until it\n"
426 "has been connected to another socket.")
427 #define FUNC_NAME s_scm_socket
431 fd
= socket (scm_to_int (family
),
436 return SCM_SOCK_FD_TO_PORT (fd
);
440 #ifdef HAVE_SOCKETPAIR
441 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
442 (SCM family
, SCM style
, SCM proto
),
443 "Return a pair of connected (but unnamed) socket ports of the\n"
444 "type specified by @var{family}, @var{style} and @var{proto}.\n"
445 "Many systems support only socket pairs of the @code{AF_UNIX}\n"
446 "family. Zero is likely to be the only meaningful value for\n"
448 #define FUNC_NAME s_scm_socketpair
453 fam
= scm_to_int (family
);
455 if (socketpair (fam
, scm_to_int (style
), scm_to_int (proto
), fd
) == -1)
458 return scm_cons (SCM_SOCK_FD_TO_PORT (fd
[0]), SCM_SOCK_FD_TO_PORT (fd
[1]));
463 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
464 (SCM sock
, SCM level
, SCM optname
),
465 "Return the value of a particular socket option for the socket\n"
466 "port @var{sock}. @var{level} is an integer code for type of\n"
467 "option being requested, e.g., @code{SOL_SOCKET} for\n"
468 "socket-level options. @var{optname} is an integer code for the\n"
469 "option required and should be specified using one of the\n"
470 "symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n\n"
471 "The returned value is typically an integer but @code{SO_LINGER}\n"
472 "returns a pair of integers.")
473 #define FUNC_NAME s_scm_getsockopt
476 /* size of optval is the largest supported option. */
477 #ifdef HAVE_STRUCT_LINGER
478 char optval
[sizeof (struct linger
)];
479 int optlen
= sizeof (struct linger
);
481 char optval
[sizeof (size_t)];
482 int optlen
= sizeof (size_t);
487 sock
= SCM_COERCE_OUTPORT (sock
);
488 SCM_VALIDATE_OPFPORT (1, sock
);
489 ilevel
= scm_to_int (level
);
490 ioptname
= scm_to_int (optname
);
492 fd
= SCM_FPORT_FDES (sock
);
493 if (getsockopt (fd
, ilevel
, ioptname
, (void *) optval
, &optlen
) == -1)
496 if (ilevel
== SOL_SOCKET
)
499 if (ioptname
== SO_LINGER
)
501 #ifdef HAVE_STRUCT_LINGER
502 struct linger
*ling
= (struct linger
*) optval
;
504 return scm_cons (scm_from_long (ling
->l_onoff
),
505 scm_from_long (ling
->l_linger
));
507 return scm_cons (scm_from_long (*(int *) optval
),
515 || ioptname
== SO_SNDBUF
518 || ioptname
== SO_RCVBUF
522 return scm_from_size_t (*(size_t *) optval
);
525 return scm_from_int (*(int *) optval
);
529 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
530 (SCM sock
, SCM level
, SCM optname
, SCM value
),
531 "Set the value of a particular socket option for the socket\n"
532 "port @var{sock}. @var{level} is an integer code for type of option\n"
533 "being set, e.g., @code{SOL_SOCKET} for socket-level options.\n"
534 "@var{optname} is an\n"
535 "integer code for the option to set and should be specified using one of\n"
536 "the symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n"
537 "@var{value} is the value to which the option should be set. For\n"
538 "most options this must be an integer, but for @code{SO_LINGER} it must\n"
540 "The return value is unspecified.")
541 #define FUNC_NAME s_scm_setsockopt
546 #ifdef HAVE_STRUCT_LINGER
547 struct linger opt_linger
;
550 #if HAVE_STRUCT_IP_MREQ
551 struct ip_mreq opt_mreq
;
554 const void *optval
= NULL
;
555 socklen_t optlen
= 0;
557 int ilevel
, ioptname
;
559 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
);
567 if (ilevel
== SOL_SOCKET
)
570 if (ioptname
== SO_LINGER
)
572 #ifdef HAVE_STRUCT_LINGER
573 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
574 opt_linger
.l_onoff
= scm_to_int (SCM_CAR (value
));
575 opt_linger
.l_linger
= scm_to_int (SCM_CDR (value
));
576 optlen
= sizeof (struct linger
);
577 optval
= &opt_linger
;
579 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
580 opt_int
= scm_to_int (SCM_CAR (value
));
581 /* timeout is ignored, but may as well validate it. */
582 scm_to_int (SCM_CDR (value
));
583 optlen
= sizeof (int);
591 || ioptname
== SO_SNDBUF
594 || ioptname
== SO_RCVBUF
598 opt_int
= scm_to_int (value
);
599 optlen
= sizeof (size_t);
604 #if HAVE_STRUCT_IP_MREQ
605 if (ilevel
== IPPROTO_IP
&&
606 (ioptname
== IP_ADD_MEMBERSHIP
|| ioptname
== IP_DROP_MEMBERSHIP
))
608 /* Fourth argument must be a pair of addresses. */
609 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
610 opt_mreq
.imr_multiaddr
.s_addr
= htonl (scm_to_ulong (SCM_CAR (value
)));
611 opt_mreq
.imr_interface
.s_addr
= htonl (scm_to_ulong (SCM_CDR (value
)));
612 optlen
= sizeof (opt_mreq
);
619 /* Most options take an int. */
620 opt_int
= scm_to_int (value
);
621 optlen
= sizeof (int);
625 if (setsockopt (fd
, ilevel
, ioptname
, optval
, optlen
) == -1)
627 return SCM_UNSPECIFIED
;
631 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
633 "Sockets can be closed simply by using @code{close-port}. The\n"
634 "@code{shutdown} procedure allows reception or transmission on a\n"
635 "connection to be shut down individually, according to the parameter\n"
639 "Stop receiving data for this socket. If further data arrives, reject it.\n"
641 "Stop trying to transmit data from this socket. Discard any\n"
642 "data waiting to be sent. Stop looking for acknowledgement of\n"
643 "data already sent; don't retransmit it if it is lost.\n"
645 "Stop both reception and transmission.\n"
647 "The return value is unspecified.")
648 #define FUNC_NAME s_scm_shutdown
651 sock
= SCM_COERCE_OUTPORT (sock
);
652 SCM_VALIDATE_OPFPORT (1, sock
);
653 fd
= SCM_FPORT_FDES (sock
);
654 if (shutdown (fd
, scm_to_signed_integer (how
, 0, 2)) == -1)
656 return SCM_UNSPECIFIED
;
660 /* convert fam/address/args into a sockaddr of the appropriate type.
661 args is modified by removing the arguments actually used.
662 which_arg and proc are used when reporting errors:
663 which_arg is the position of address in the original argument list.
664 proc is the name of the original procedure.
665 size returns the size of the structure allocated. */
667 static struct sockaddr
*
668 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
669 const char *proc
, int *size
)
670 #define FUNC_NAME proc
676 struct sockaddr_in
*soka
;
680 SCM_VALIDATE_ULONG_COPY (which_arg
, address
, addr
);
681 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
682 port
= scm_to_int (SCM_CAR (*args
));
683 *args
= SCM_CDR (*args
);
684 soka
= (struct sockaddr_in
*) scm_malloc (sizeof (struct sockaddr_in
));
686 scm_memory_error (proc
);
687 #if HAVE_STRUCT_SOCKADDR_SIN_LEN
688 soka
->sin_len
= sizeof (struct sockaddr_in
);
690 soka
->sin_family
= AF_INET
;
691 soka
->sin_addr
.s_addr
= htonl (addr
);
692 soka
->sin_port
= htons (port
);
693 *size
= sizeof (struct sockaddr_in
);
694 return (struct sockaddr
*) soka
;
701 struct sockaddr_in6
*soka
;
702 unsigned long flowinfo
= 0;
703 unsigned long scope_id
= 0;
705 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
706 port
= scm_to_int (SCM_CAR (*args
));
707 *args
= SCM_CDR (*args
);
708 if (scm_is_pair (*args
))
710 SCM_VALIDATE_ULONG_COPY (which_arg
+ 2, SCM_CAR (*args
), flowinfo
);
711 *args
= SCM_CDR (*args
);
712 if (scm_is_pair (*args
))
714 SCM_VALIDATE_ULONG_COPY (which_arg
+ 3, SCM_CAR (*args
),
716 *args
= SCM_CDR (*args
);
719 soka
= (struct sockaddr_in6
*) scm_malloc (sizeof (struct sockaddr_in6
));
721 scm_memory_error (proc
);
722 #if HAVE_STRUCT_SOCKADDR_IN6_SIN6_LEN
723 soka
->sin6_len
= sizeof (struct sockaddr_in6
);
725 soka
->sin6_family
= AF_INET6
;
726 scm_to_ipv6 (soka
->sin6_addr
.s6_addr
, address
);
727 soka
->sin6_port
= htons (port
);
728 soka
->sin6_flowinfo
= flowinfo
;
729 #ifdef HAVE_SIN6_SCOPE_ID
730 soka
->sin6_scope_id
= scope_id
;
732 *size
= sizeof (struct sockaddr_in6
);
733 return (struct sockaddr
*) soka
;
736 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
739 struct sockaddr_un
*soka
;
745 c_address
= scm_to_locale_string (address
);
746 scm_frame_free (c_address
);
748 /* the static buffer size in sockaddr_un seems to be arbitrary
749 and not necessarily a hard limit. e.g., the glibc manual
750 suggests it may be possible to declare it size 0. let's
751 ignore it. if the O/S doesn't like the size it will cause
752 connect/bind etc., to fail. sun_path is always the last
753 member of the structure. */
754 addr_size
= sizeof (struct sockaddr_un
)
755 + max (0, strlen (c_address
) + 1 - (sizeof soka
->sun_path
));
756 soka
= (struct sockaddr_un
*) scm_malloc (addr_size
);
757 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
758 soka
->sun_family
= AF_UNIX
;
759 strcpy (soka
->sun_path
, c_address
);
760 *size
= SUN_LEN (soka
);
763 return (struct sockaddr
*) soka
;
767 scm_out_of_range (proc
, scm_from_int (fam
));
772 SCM_DEFINE (scm_connect
, "connect", 3, 0, 1,
773 (SCM sock
, SCM fam
, SCM address
, SCM args
),
774 "Initiate a connection from a socket using a specified address\n"
775 "family to the address\n"
776 "specified by @var{address} and possibly @var{args}.\n"
777 "The format required for @var{address}\n"
778 "and @var{args} depends on the family of the socket.\n\n"
779 "For a socket of family @code{AF_UNIX},\n"
780 "only @var{address} is specified and must be a string with the\n"
781 "filename where the socket is to be created.\n\n"
782 "For a socket of family @code{AF_INET},\n"
783 "@var{address} must be an integer IPv4 host address and\n"
784 "@var{args} must be a single integer port number.\n\n"
785 "For a socket of family @code{AF_INET6},\n"
786 "@var{address} must be an integer IPv6 host address and\n"
787 "@var{args} may be up to three integers:\n"
788 "port [flowinfo] [scope_id],\n"
789 "where flowinfo and scope_id default to zero.\n\n"
790 "The return value is unspecified.")
791 #define FUNC_NAME s_scm_connect
794 struct sockaddr
*soka
;
797 sock
= SCM_COERCE_OUTPORT (sock
);
798 SCM_VALIDATE_OPFPORT (1, sock
);
799 fd
= SCM_FPORT_FDES (sock
);
800 soka
= scm_fill_sockaddr (scm_to_int (fam
), address
, &args
, 3, FUNC_NAME
,
802 if (connect (fd
, soka
, size
) == -1)
804 int save_errno
= errno
;
811 return SCM_UNSPECIFIED
;
815 SCM_DEFINE (scm_bind
, "bind", 3, 0, 1,
816 (SCM sock
, SCM fam
, SCM address
, SCM args
),
817 "Assign an address to the socket port @var{sock}.\n"
818 "Generally this only needs to be done for server sockets,\n"
819 "so they know where to look for incoming connections. A socket\n"
820 "without an address will be assigned one automatically when it\n"
821 "starts communicating.\n\n"
822 "The format of @var{address} and @var{args} depends\n"
823 "on the family of the socket.\n\n"
824 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
825 "is specified and must be a string with the filename where\n"
826 "the socket is to be created.\n\n"
827 "For a socket of family @code{AF_INET}, @var{address}\n"
828 "must be an integer IPv4 address and @var{args}\n"
829 "must be a single integer port number.\n\n"
830 "The values of the following variables can also be used for\n"
832 "@defvar INADDR_ANY\n"
833 "Allow connections from any address.\n"
835 "@defvar INADDR_LOOPBACK\n"
836 "The address of the local host using the loopback device.\n"
838 "@defvar INADDR_BROADCAST\n"
839 "The broadcast address on the local network.\n"
841 "@defvar INADDR_NONE\n"
844 "For a socket of family @code{AF_INET6}, @var{address}\n"
845 "must be an integer IPv6 address and @var{args}\n"
846 "may be up to three integers:\n"
847 "port [flowinfo] [scope_id],\n"
848 "where flowinfo and scope_id default to zero.\n\n"
849 "The return value is unspecified.")
850 #define FUNC_NAME s_scm_bind
852 struct sockaddr
*soka
;
856 sock
= SCM_COERCE_OUTPORT (sock
);
857 SCM_VALIDATE_OPFPORT (1, sock
);
858 soka
= scm_fill_sockaddr (scm_to_int (fam
), address
, &args
, 3, FUNC_NAME
,
860 fd
= SCM_FPORT_FDES (sock
);
861 if (bind (fd
, soka
, size
) == -1)
863 int save_errno
= errno
;
870 return SCM_UNSPECIFIED
;
874 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
875 (SCM sock
, SCM backlog
),
876 "Enable @var{sock} to accept connection\n"
877 "requests. @var{backlog} is an integer specifying\n"
878 "the maximum length of the queue for pending connections.\n"
879 "If the queue fills, new clients will fail to connect until\n"
880 "the server calls @code{accept} to accept a connection from\n"
882 "The return value is unspecified.")
883 #define FUNC_NAME s_scm_listen
886 sock
= SCM_COERCE_OUTPORT (sock
);
887 SCM_VALIDATE_OPFPORT (1, sock
);
888 fd
= SCM_FPORT_FDES (sock
);
889 if (listen (fd
, scm_to_int (backlog
)) == -1)
891 return SCM_UNSPECIFIED
;
895 /* Put the components of a sockaddr into a new SCM vector. */
897 scm_addr_vector (const struct sockaddr
*address
, int addr_size
,
900 short int fam
= address
->sa_family
;
908 const struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
910 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
912 SCM_SIMPLE_VECTOR_SET(result
, 0,
913 scm_from_short (fam
));
914 SCM_SIMPLE_VECTOR_SET(result
, 1,
915 scm_from_ulong (ntohl (nad
->sin_addr
.s_addr
)));
916 SCM_SIMPLE_VECTOR_SET(result
, 2,
917 scm_from_ushort (ntohs (nad
->sin_port
)));
923 const struct sockaddr_in6
*nad
= (struct sockaddr_in6
*) address
;
925 result
= scm_c_make_vector (5, SCM_UNSPECIFIED
);
926 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
927 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_ipv6 (nad
->sin6_addr
.s6_addr
));
928 SCM_SIMPLE_VECTOR_SET(result
, 2, scm_from_ushort (ntohs (nad
->sin6_port
)));
929 SCM_SIMPLE_VECTOR_SET(result
, 3, scm_from_uint32 (nad
->sin6_flowinfo
));
930 #ifdef HAVE_SIN6_SCOPE_ID
931 SCM_SIMPLE_VECTOR_SET(result
, 4, scm_from_ulong (nad
->sin6_scope_id
));
933 SCM_SIMPLE_VECTOR_SET(result
, 4, SCM_INUM0
);
938 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
941 const struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
943 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
945 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
946 /* When addr_size is not enough to cover sun_path, do not try
948 if (addr_size
<= offsetof (struct sockaddr_un
, sun_path
))
949 SCM_SIMPLE_VECTOR_SET(result
, 1, SCM_BOOL_F
);
951 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_locale_string (nad
->sun_path
));
956 scm_misc_error (proc
, "Unrecognised address family: ~A",
957 scm_list_1 (scm_from_int (fam
)));
962 /* calculate the size of a buffer large enough to hold any supported
963 sockaddr type. if the buffer isn't large enough, certain system
964 calls will return a truncated address. */
966 #if defined (HAVE_UNIX_DOMAIN_SOCKETS)
967 #define MAX_SIZE_UN sizeof (struct sockaddr_un)
969 #define MAX_SIZE_UN 0
972 #if defined (HAVE_IPV6)
973 #define MAX_SIZE_IN6 sizeof (struct sockaddr_in6)
975 #define MAX_SIZE_IN6 0
978 #define MAX_ADDR_SIZE max (max (sizeof (struct sockaddr_in), MAX_SIZE_IN6),\
981 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
983 "Accept a connection on a bound, listening socket.\n"
985 "are no pending connections in the queue, wait until\n"
986 "one is available unless the non-blocking option has been\n"
987 "set on the socket.\n\n"
988 "The return value is a\n"
989 "pair in which the @emph{car} is a new socket port for the\n"
991 "the @emph{cdr} is an object with address information about the\n"
992 "client which initiated the connection.\n\n"
993 "@var{sock} does not become part of the\n"
994 "connection and will continue to accept new requests.")
995 #define FUNC_NAME s_scm_accept
1001 int addr_size
= MAX_ADDR_SIZE
;
1002 char max_addr
[MAX_ADDR_SIZE
];
1003 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1005 sock
= SCM_COERCE_OUTPORT (sock
);
1006 SCM_VALIDATE_OPFPORT (1, sock
);
1007 fd
= SCM_FPORT_FDES (sock
);
1008 newfd
= accept (fd
, addr
, &addr_size
);
1011 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
1012 address
= scm_addr_vector (addr
, addr_size
, FUNC_NAME
);
1013 return scm_cons (newsock
, address
);
1017 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
1019 "Return the address of @var{sock}, in the same form as the\n"
1020 "object returned by @code{accept}. On many systems the address\n"
1021 "of a socket in the @code{AF_FILE} namespace cannot be read.")
1022 #define FUNC_NAME s_scm_getsockname
1025 int addr_size
= MAX_ADDR_SIZE
;
1026 char max_addr
[MAX_ADDR_SIZE
];
1027 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1029 sock
= SCM_COERCE_OUTPORT (sock
);
1030 SCM_VALIDATE_OPFPORT (1, sock
);
1031 fd
= SCM_FPORT_FDES (sock
);
1032 if (getsockname (fd
, addr
, &addr_size
) == -1)
1034 return scm_addr_vector (addr
, addr_size
, FUNC_NAME
);
1038 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
1040 "Return the address that @var{sock}\n"
1041 "is connected to, in the same form as the object returned by\n"
1042 "@code{accept}. On many systems the address of a socket in the\n"
1043 "@code{AF_FILE} namespace cannot be read.")
1044 #define FUNC_NAME s_scm_getpeername
1047 int addr_size
= MAX_ADDR_SIZE
;
1048 char max_addr
[MAX_ADDR_SIZE
];
1049 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1051 sock
= SCM_COERCE_OUTPORT (sock
);
1052 SCM_VALIDATE_OPFPORT (1, sock
);
1053 fd
= SCM_FPORT_FDES (sock
);
1054 if (getpeername (fd
, addr
, &addr_size
) == -1)
1056 return scm_addr_vector (addr
, addr_size
, FUNC_NAME
);
1060 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
1061 (SCM sock
, SCM buf
, SCM flags
),
1062 "Receive data from a socket port.\n"
1063 "@var{sock} must already\n"
1064 "be bound to the address from which data is to be received.\n"
1065 "@var{buf} is a string into which\n"
1066 "the data will be written. The size of @var{buf} limits\n"
1068 "data which can be received: in the case of packet\n"
1069 "protocols, if a packet larger than this limit is encountered\n"
1071 "will be irrevocably lost.\n\n"
1072 "The optional @var{flags} argument is a value or\n"
1073 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1074 "The value returned is the number of bytes read from the\n"
1076 "Note that the data is read directly from the socket file\n"
1078 "any unread buffered port data is ignored.")
1079 #define FUNC_NAME s_scm_recv
1087 SCM_VALIDATE_OPFPORT (1, sock
);
1088 SCM_VALIDATE_STRING (2, buf
);
1089 if (SCM_UNBNDP (flags
))
1092 flg
= scm_to_int (flags
);
1093 fd
= SCM_FPORT_FDES (sock
);
1095 len
= scm_i_string_length (buf
);
1096 dest
= scm_i_string_writable_chars (buf
);
1097 SCM_SYSCALL (rv
= recv (fd
, dest
, len
, flg
));
1098 scm_i_string_stop_writing ();
1103 scm_remember_upto_here_1 (buf
);
1104 return scm_from_int (rv
);
1108 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
1109 (SCM sock
, SCM message
, SCM flags
),
1110 "Transmit the string @var{message} on a socket port @var{sock}.\n"
1111 "@var{sock} must already be bound to a destination address. The\n"
1112 "value returned is the number of bytes transmitted --\n"
1113 "it's possible for\n"
1114 "this to be less than the length of @var{message}\n"
1115 "if the socket is\n"
1116 "set to be non-blocking. The optional @var{flags} argument\n"
1118 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1119 "Note that the data is written directly to the socket\n"
1120 "file descriptor:\n"
1121 "any unflushed buffered port data is ignored.")
1122 #define FUNC_NAME s_scm_send
1130 sock
= SCM_COERCE_OUTPORT (sock
);
1131 SCM_VALIDATE_OPFPORT (1, sock
);
1132 SCM_VALIDATE_STRING (2, message
);
1133 if (SCM_UNBNDP (flags
))
1136 flg
= scm_to_int (flags
);
1137 fd
= SCM_FPORT_FDES (sock
);
1139 len
= scm_i_string_length (message
);
1140 src
= scm_i_string_writable_chars (message
);
1141 SCM_SYSCALL (rv
= send (fd
, src
, len
, flg
));
1142 scm_i_string_stop_writing ();
1147 scm_remember_upto_here_1 (message
);
1148 return scm_from_int (rv
);
1152 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
1153 (SCM sock
, SCM str
, SCM flags
, SCM start
, SCM end
),
1154 "Return data from the socket port @var{sock} and also\n"
1155 "information about where the data was received from.\n"
1156 "@var{sock} must already be bound to the address from which\n"
1157 "data is to be received. @code{str}, is a string into which the\n"
1158 "data will be written. The size of @var{str} limits the amount\n"
1159 "of data which can be received: in the case of packet protocols,\n"
1160 "if a packet larger than this limit is encountered then some\n"
1161 "data will be irrevocably lost.\n\n"
1162 "The optional @var{flags} argument is a value or bitwise OR of\n"
1163 "@code{MSG_OOB}, @code{MSG_PEEK}, @code{MSG_DONTROUTE} etc.\n\n"
1164 "The value returned is a pair: the @emph{car} is the number of\n"
1165 "bytes read from the socket and the @emph{cdr} an address object\n"
1166 "in the same form as returned by @code{accept}. The address\n"
1167 "will given as @code{#f} if not available, as is usually the\n"
1168 "case for stream sockets.\n\n"
1169 "The @var{start} and @var{end} arguments specify a substring of\n"
1170 "@var{str} to which the data should be written.\n\n"
1171 "Note that the data is read directly from the socket file\n"
1172 "descriptor: any unread buffered port data is ignored.")
1173 #define FUNC_NAME s_scm_recvfrom
1182 int addr_size
= MAX_ADDR_SIZE
;
1183 char max_addr
[MAX_ADDR_SIZE
];
1184 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1186 SCM_VALIDATE_OPFPORT (1, sock
);
1187 fd
= SCM_FPORT_FDES (sock
);
1189 SCM_VALIDATE_STRING (2, str
);
1190 scm_i_get_substring_spec (scm_i_string_length (str
),
1191 start
, &offset
, end
, &cend
);
1193 if (SCM_UNBNDP (flags
))
1196 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
1198 /* recvfrom will not necessarily return an address. usually nothing
1199 is returned for stream sockets. */
1200 buf
= scm_i_string_writable_chars (str
);
1201 addr
->sa_family
= AF_UNSPEC
;
1202 SCM_SYSCALL (rv
= recvfrom (fd
, buf
+ offset
,
1205 scm_i_string_stop_writing ();
1209 if (addr
->sa_family
!= AF_UNSPEC
)
1210 address
= scm_addr_vector (addr
, addr_size
, FUNC_NAME
);
1212 address
= SCM_BOOL_F
;
1214 scm_remember_upto_here_1 (str
);
1215 return scm_cons (scm_from_int (rv
), address
);
1219 SCM_DEFINE (scm_sendto
, "sendto", 4, 0, 1,
1220 (SCM sock
, SCM message
, SCM fam
, SCM address
, SCM args_and_flags
),
1221 "Transmit the string @var{message} on the socket port\n"
1223 "destination address is specified using the @var{fam},\n"
1224 "@var{address} and\n"
1225 "@var{args_and_flags} arguments, in a similar way to the\n"
1226 "@code{connect} procedure. @var{args_and_flags} contains\n"
1227 "the usual connection arguments optionally followed by\n"
1228 "a flags argument, which is a value or\n"
1229 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1230 "The value returned is the number of bytes transmitted --\n"
1231 "it's possible for\n"
1232 "this to be less than the length of @var{message} if the\n"
1234 "set to be non-blocking.\n"
1235 "Note that the data is written directly to the socket\n"
1236 "file descriptor:\n"
1237 "any unflushed buffered port data is ignored.")
1238 #define FUNC_NAME s_scm_sendto
1243 struct sockaddr
*soka
;
1246 sock
= SCM_COERCE_OUTPORT (sock
);
1247 SCM_VALIDATE_FPORT (1, sock
);
1248 SCM_VALIDATE_STRING (2, message
);
1249 fd
= SCM_FPORT_FDES (sock
);
1250 soka
= scm_fill_sockaddr (scm_to_int (fam
), address
, &args_and_flags
, 4,
1252 if (scm_is_null (args_and_flags
))
1256 SCM_VALIDATE_CONS (5, args_and_flags
);
1257 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
1259 SCM_SYSCALL (rv
= sendto (fd
,
1260 scm_i_string_chars (message
),
1261 scm_i_string_length (message
),
1265 int save_errno
= errno
;
1272 scm_remember_upto_here_1 (message
);
1273 return scm_from_int (rv
);
1282 /* protocol families. */
1284 scm_c_define ("AF_UNSPEC", scm_from_int (AF_UNSPEC
));
1287 scm_c_define ("AF_UNIX", scm_from_int (AF_UNIX
));
1290 scm_c_define ("AF_INET", scm_from_int (AF_INET
));
1293 scm_c_define ("AF_INET6", scm_from_int (AF_INET6
));
1297 scm_c_define ("PF_UNSPEC", scm_from_int (PF_UNSPEC
));
1300 scm_c_define ("PF_UNIX", scm_from_int (PF_UNIX
));
1303 scm_c_define ("PF_INET", scm_from_int (PF_INET
));
1306 scm_c_define ("PF_INET6", scm_from_int (PF_INET6
));
1309 /* standard addresses. */
1311 scm_c_define ("INADDR_ANY", scm_from_ulong (INADDR_ANY
));
1313 #ifdef INADDR_BROADCAST
1314 scm_c_define ("INADDR_BROADCAST", scm_from_ulong (INADDR_BROADCAST
));
1317 scm_c_define ("INADDR_NONE", scm_from_ulong (INADDR_NONE
));
1319 #ifdef INADDR_LOOPBACK
1320 scm_c_define ("INADDR_LOOPBACK", scm_from_ulong (INADDR_LOOPBACK
));
1325 SOCK_PACKET is deliberately omitted, the GNU/Linux socket(2) and
1326 packet(7) advise that it's obsolete and strongly deprecated. */
1329 scm_c_define ("SOCK_STREAM", scm_from_int (SOCK_STREAM
));
1332 scm_c_define ("SOCK_DGRAM", scm_from_int (SOCK_DGRAM
));
1334 #ifdef SOCK_SEQPACKET
1335 scm_c_define ("SOCK_SEQPACKET", scm_from_int (SOCK_SEQPACKET
));
1338 scm_c_define ("SOCK_RAW", scm_from_int (SOCK_RAW
));
1341 scm_c_define ("SOCK_RDM", scm_from_int (SOCK_RDM
));
1344 /* setsockopt level. */
1346 scm_c_define ("SOL_SOCKET", scm_from_int (SOL_SOCKET
));
1349 scm_c_define ("SOL_IP", scm_from_int (SOL_IP
));
1352 scm_c_define ("SOL_TCP", scm_from_int (SOL_TCP
));
1355 scm_c_define ("SOL_UDP", scm_from_int (SOL_UDP
));
1358 /* setsockopt names. */
1360 scm_c_define ("SO_DEBUG", scm_from_int (SO_DEBUG
));
1363 scm_c_define ("SO_REUSEADDR", scm_from_int (SO_REUSEADDR
));
1366 scm_c_define ("SO_STYLE", scm_from_int (SO_STYLE
));
1369 scm_c_define ("SO_TYPE", scm_from_int (SO_TYPE
));
1372 scm_c_define ("SO_ERROR", scm_from_int (SO_ERROR
));
1375 scm_c_define ("SO_DONTROUTE", scm_from_int (SO_DONTROUTE
));
1378 scm_c_define ("SO_BROADCAST", scm_from_int (SO_BROADCAST
));
1381 scm_c_define ("SO_SNDBUF", scm_from_int (SO_SNDBUF
));
1384 scm_c_define ("SO_RCVBUF", scm_from_int (SO_RCVBUF
));
1387 scm_c_define ("SO_KEEPALIVE", scm_from_int (SO_KEEPALIVE
));
1390 scm_c_define ("SO_OOBINLINE", scm_from_int (SO_OOBINLINE
));
1393 scm_c_define ("SO_NO_CHECK", scm_from_int (SO_NO_CHECK
));
1396 scm_c_define ("SO_PRIORITY", scm_from_int (SO_PRIORITY
));
1399 scm_c_define ("SO_LINGER", scm_from_int (SO_LINGER
));
1402 /* recv/send options. */
1404 scm_c_define ("MSG_OOB", scm_from_int (MSG_OOB
));
1407 scm_c_define ("MSG_PEEK", scm_from_int (MSG_PEEK
));
1409 #ifdef MSG_DONTROUTE
1410 scm_c_define ("MSG_DONTROUTE", scm_from_int (MSG_DONTROUTE
));
1414 scm_i_init_socket_Win32 ();
1417 #ifdef IP_ADD_MEMBERSHIP
1418 scm_c_define ("IP_ADD_MEMBERSHIP", scm_from_int (IP_ADD_MEMBERSHIP
));
1419 scm_c_define ("IP_DROP_MEMBERSHIP", scm_from_int (IP_DROP_MEMBERSHIP
));
1422 scm_add_feature ("socket");
1424 #include "libguile/socket.x"