1 /* Copyright (C) 1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005 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 ((scm_t_uint8
*) 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 ((scm_t_uint8
*) 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 an option value from socket port @var{sock}.\n"
467 "@var{level} is an integer specifying a protocol layer, either\n"
468 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
469 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
470 "(@pxref{Network Databases}).\n"
472 "@defvar SOL_SOCKET\n"
473 "@defvarx IPPROTO_IP\n"
474 "@defvarx IPPROTO_TCP\n"
475 "@defvarx IPPROTO_UDP\n"
478 "@var{optname} is an integer specifying an option within the\n"
481 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
482 "defined (when provided by the system). For their meaning see\n"
483 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
484 "Manual}, or @command{man 7 socket}.\n"
487 "@defvarx SO_REUSEADDR\n"
488 "@defvarx SO_STYLE\n"
490 "@defvarx SO_ERROR\n"
491 "@defvarx SO_DONTROUTE\n"
492 "@defvarx SO_BROADCAST\n"
493 "@defvarx SO_SNDBUF\n"
494 "@defvarx SO_RCVBUF\n"
495 "@defvarx SO_KEEPALIVE\n"
496 "@defvarx SO_OOBINLINE\n"
497 "@defvarx SO_NO_CHECK\n"
498 "@defvarx SO_PRIORITY\n"
499 "The value returned is an integer.\n"
502 "@defvar SO_LINGER\n"
503 "The @var{value} returned is a pair of integers\n"
504 "@code{(@var{ENABLE} . @var{TIMEOUT})}. On old systems without\n"
505 "timeout support (ie.@: without @code{struct linger}), only\n"
506 "@var{ENABLE} has an effect but the value in Guile is always a\n"
509 #define FUNC_NAME s_scm_getsockopt
512 /* size of optval is the largest supported option. */
513 #ifdef HAVE_STRUCT_LINGER
514 char optval
[sizeof (struct linger
)];
515 socklen_t optlen
= sizeof (struct linger
);
517 char optval
[sizeof (size_t)];
518 socklen_t optlen
= sizeof (size_t);
523 sock
= SCM_COERCE_OUTPORT (sock
);
524 SCM_VALIDATE_OPFPORT (1, sock
);
525 ilevel
= scm_to_int (level
);
526 ioptname
= scm_to_int (optname
);
528 fd
= SCM_FPORT_FDES (sock
);
529 if (getsockopt (fd
, ilevel
, ioptname
, (void *) optval
, &optlen
) == -1)
532 if (ilevel
== SOL_SOCKET
)
535 if (ioptname
== SO_LINGER
)
537 #ifdef HAVE_STRUCT_LINGER
538 struct linger
*ling
= (struct linger
*) optval
;
540 return scm_cons (scm_from_long (ling
->l_onoff
),
541 scm_from_long (ling
->l_linger
));
543 return scm_cons (scm_from_long (*(int *) optval
),
551 || ioptname
== SO_SNDBUF
554 || ioptname
== SO_RCVBUF
558 return scm_from_size_t (*(size_t *) optval
);
561 return scm_from_int (*(int *) optval
);
565 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
566 (SCM sock
, SCM level
, SCM optname
, SCM value
),
567 "Set an option on socket port @var{sock}. The return value is\n"
570 "@var{level} is an integer specifying a protocol layer, either\n"
571 "@code{SOL_SOCKET} for socket level options, or a protocol\n"
572 "number from the @code{IPPROTO} constants or @code{getprotoent}\n"
573 "(@pxref{Network Databases}).\n"
575 "@defvar SOL_SOCKET\n"
576 "@defvarx IPPROTO_IP\n"
577 "@defvarx IPPROTO_TCP\n"
578 "@defvarx IPPROTO_UDP\n"
581 "@var{optname} is an integer specifying an option within the\n"
584 "For @code{SOL_SOCKET} level the following @var{optname}s are\n"
585 "defined (when provided by the system). For their meaning see\n"
586 "@ref{Socket-Level Options,,, libc, The GNU C Library Reference\n"
587 "Manual}, or @command{man 7 socket}.\n"
590 "@defvarx SO_REUSEADDR\n"
591 "@defvarx SO_STYLE\n"
593 "@defvarx SO_ERROR\n"
594 "@defvarx SO_DONTROUTE\n"
595 "@defvarx SO_BROADCAST\n"
596 "@defvarx SO_SNDBUF\n"
597 "@defvarx SO_RCVBUF\n"
598 "@defvarx SO_KEEPALIVE\n"
599 "@defvarx SO_OOBINLINE\n"
600 "@defvarx SO_NO_CHECK\n"
601 "@defvarx SO_PRIORITY\n"
602 "@var{value} is an integer.\n"
605 "@defvar SO_LINGER\n"
606 "@var{value} is a pair of integers @code{(@var{ENABLE}\n"
607 ". @var{TIMEOUT})}. On old systems without timeout support\n"
608 "(ie.@: without @code{struct linger}), only @var{ENABLE} has an\n"
609 "effect but the value in Guile is always a pair.\n"
612 "@c Note that we refer only to ``man ip'' here. On GNU/Linux it's\n"
613 "@c ``man 7 ip'' but on NetBSD it's ``man 4 ip''.\n"
615 "For IP level (@code{IPPROTO_IP}) the following @var{optname}s\n"
616 "are defined (when provided by the system). See @command{man\n"
617 "ip} for what they mean.\n"
619 "@defvar IP_ADD_MEMBERSHIP\n"
620 "@defvarx IP_DROP_MEMBERSHIP\n"
621 "These can be used only with @code{setsockopt}, not\n"
622 "@code{getsockopt}. @var{value} is a pair\n"
623 "@code{(@var{MULTIADDR} . @var{INTERFACEADDR})} of IPv4\n"
624 "addresses (@pxref{Network Address Conversion}).\n"
625 "@var{MULTIADDR} is a multicast address to be added to or\n"
626 "dropped from the interface @var{INTERFACEADDR}.\n"
627 "@var{INTERFACEADDR} can be @code{INADDR_ANY} to have the system\n"
628 "select the interface. @var{INTERFACEADDR} can also be an\n"
629 "interface index number, on systems supporting that.\n"
631 #define FUNC_NAME s_scm_setsockopt
636 #ifdef HAVE_STRUCT_LINGER
637 struct linger opt_linger
;
640 #if HAVE_STRUCT_IP_MREQ
641 struct ip_mreq opt_mreq
;
644 const void *optval
= NULL
;
645 socklen_t optlen
= 0;
647 int ilevel
, ioptname
;
649 sock
= SCM_COERCE_OUTPORT (sock
);
651 SCM_VALIDATE_OPFPORT (1, sock
);
652 ilevel
= scm_to_int (level
);
653 ioptname
= scm_to_int (optname
);
655 fd
= SCM_FPORT_FDES (sock
);
657 if (ilevel
== SOL_SOCKET
)
660 if (ioptname
== SO_LINGER
)
662 #ifdef HAVE_STRUCT_LINGER
663 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
664 opt_linger
.l_onoff
= scm_to_int (SCM_CAR (value
));
665 opt_linger
.l_linger
= scm_to_int (SCM_CDR (value
));
666 optlen
= sizeof (struct linger
);
667 optval
= &opt_linger
;
669 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
670 opt_int
= scm_to_int (SCM_CAR (value
));
671 /* timeout is ignored, but may as well validate it. */
672 scm_to_int (SCM_CDR (value
));
673 optlen
= sizeof (int);
681 || ioptname
== SO_SNDBUF
684 || ioptname
== SO_RCVBUF
688 opt_int
= scm_to_int (value
);
689 optlen
= sizeof (size_t);
694 #if HAVE_STRUCT_IP_MREQ
695 if (ilevel
== IPPROTO_IP
&&
696 (ioptname
== IP_ADD_MEMBERSHIP
|| ioptname
== IP_DROP_MEMBERSHIP
))
698 /* Fourth argument must be a pair of addresses. */
699 SCM_ASSERT (scm_is_pair (value
), value
, SCM_ARG4
, FUNC_NAME
);
700 opt_mreq
.imr_multiaddr
.s_addr
= htonl (scm_to_ulong (SCM_CAR (value
)));
701 opt_mreq
.imr_interface
.s_addr
= htonl (scm_to_ulong (SCM_CDR (value
)));
702 optlen
= sizeof (opt_mreq
);
709 /* Most options take an int. */
710 opt_int
= scm_to_int (value
);
711 optlen
= sizeof (int);
715 if (setsockopt (fd
, ilevel
, ioptname
, optval
, optlen
) == -1)
717 return SCM_UNSPECIFIED
;
721 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
723 "Sockets can be closed simply by using @code{close-port}. The\n"
724 "@code{shutdown} procedure allows reception or transmission on a\n"
725 "connection to be shut down individually, according to the parameter\n"
729 "Stop receiving data for this socket. If further data arrives, reject it.\n"
731 "Stop trying to transmit data from this socket. Discard any\n"
732 "data waiting to be sent. Stop looking for acknowledgement of\n"
733 "data already sent; don't retransmit it if it is lost.\n"
735 "Stop both reception and transmission.\n"
737 "The return value is unspecified.")
738 #define FUNC_NAME s_scm_shutdown
741 sock
= SCM_COERCE_OUTPORT (sock
);
742 SCM_VALIDATE_OPFPORT (1, sock
);
743 fd
= SCM_FPORT_FDES (sock
);
744 if (shutdown (fd
, scm_to_signed_integer (how
, 0, 2)) == -1)
746 return SCM_UNSPECIFIED
;
750 /* convert fam/address/args into a sockaddr of the appropriate type.
751 args is modified by removing the arguments actually used.
752 which_arg and proc are used when reporting errors:
753 which_arg is the position of address in the original argument list.
754 proc is the name of the original procedure.
755 size returns the size of the structure allocated. */
757 static struct sockaddr
*
758 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
759 const char *proc
, size_t *size
)
760 #define FUNC_NAME proc
766 struct sockaddr_in
*soka
;
770 SCM_VALIDATE_ULONG_COPY (which_arg
, address
, addr
);
771 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
772 port
= scm_to_int (SCM_CAR (*args
));
773 *args
= SCM_CDR (*args
);
774 soka
= (struct sockaddr_in
*) scm_malloc (sizeof (struct sockaddr_in
));
776 #if HAVE_STRUCT_SOCKADDR_SIN_LEN
777 soka
->sin_len
= sizeof (struct sockaddr_in
);
779 soka
->sin_family
= AF_INET
;
780 soka
->sin_addr
.s_addr
= htonl (addr
);
781 soka
->sin_port
= htons (port
);
782 *size
= sizeof (struct sockaddr_in
);
783 return (struct sockaddr
*) soka
;
790 struct sockaddr_in6
*soka
;
791 unsigned long flowinfo
= 0;
792 unsigned long scope_id
= 0;
794 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
795 port
= scm_to_int (SCM_CAR (*args
));
796 *args
= SCM_CDR (*args
);
797 if (scm_is_pair (*args
))
799 SCM_VALIDATE_ULONG_COPY (which_arg
+ 2, SCM_CAR (*args
), flowinfo
);
800 *args
= SCM_CDR (*args
);
801 if (scm_is_pair (*args
))
803 SCM_VALIDATE_ULONG_COPY (which_arg
+ 3, SCM_CAR (*args
),
805 *args
= SCM_CDR (*args
);
808 soka
= (struct sockaddr_in6
*) scm_malloc (sizeof (struct sockaddr_in6
));
810 #if HAVE_STRUCT_SOCKADDR_IN6_SIN6_LEN
811 soka
->sin6_len
= sizeof (struct sockaddr_in6
);
813 soka
->sin6_family
= AF_INET6
;
814 scm_to_ipv6 (soka
->sin6_addr
.s6_addr
, address
);
815 soka
->sin6_port
= htons (port
);
816 soka
->sin6_flowinfo
= flowinfo
;
817 #ifdef HAVE_SIN6_SCOPE_ID
818 soka
->sin6_scope_id
= scope_id
;
820 *size
= sizeof (struct sockaddr_in6
);
821 return (struct sockaddr
*) soka
;
824 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
827 struct sockaddr_un
*soka
;
833 c_address
= scm_to_locale_string (address
);
834 scm_frame_free (c_address
);
836 /* the static buffer size in sockaddr_un seems to be arbitrary
837 and not necessarily a hard limit. e.g., the glibc manual
838 suggests it may be possible to declare it size 0. let's
839 ignore it. if the O/S doesn't like the size it will cause
840 connect/bind etc., to fail. sun_path is always the last
841 member of the structure. */
842 addr_size
= sizeof (struct sockaddr_un
)
843 + max (0, strlen (c_address
) + 1 - (sizeof soka
->sun_path
));
844 soka
= (struct sockaddr_un
*) scm_malloc (addr_size
);
845 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
846 soka
->sun_family
= AF_UNIX
;
847 strcpy (soka
->sun_path
, c_address
);
848 *size
= SUN_LEN (soka
);
851 return (struct sockaddr
*) soka
;
855 scm_out_of_range (proc
, scm_from_int (fam
));
860 SCM_DEFINE (scm_connect
, "connect", 2, 1, 1,
861 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
862 "Initiate a connection from a socket using a specified address\n"
863 "family to the address\n"
864 "specified by @var{address} and possibly @var{args}.\n"
865 "The format required for @var{address}\n"
866 "and @var{args} depends on the family of the socket.\n\n"
867 "For a socket of family @code{AF_UNIX},\n"
868 "only @var{address} is specified and must be a string with the\n"
869 "filename where the socket is to be created.\n\n"
870 "For a socket of family @code{AF_INET},\n"
871 "@var{address} must be an integer IPv4 host address and\n"
872 "@var{args} must be a single integer port number.\n\n"
873 "For a socket of family @code{AF_INET6},\n"
874 "@var{address} must be an integer IPv6 host address and\n"
875 "@var{args} may be up to three integers:\n"
876 "port [flowinfo] [scope_id],\n"
877 "where flowinfo and scope_id default to zero.\n\n"
878 "Alternatively, the second argument can be a socket address object "
879 "as returned by @code{make-socket-address}, in which case the "
880 "no additional arguments should be passed.\n\n"
881 "The return value is unspecified.")
882 #define FUNC_NAME s_scm_connect
885 struct sockaddr
*soka
;
888 sock
= SCM_COERCE_OUTPORT (sock
);
889 SCM_VALIDATE_OPFPORT (1, sock
);
890 fd
= SCM_FPORT_FDES (sock
);
892 if (address
== SCM_UNDEFINED
)
893 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
894 `socket address' object. */
895 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
897 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
898 &args
, 3, FUNC_NAME
, &size
);
900 if (connect (fd
, soka
, size
) == -1)
902 int save_errno
= errno
;
909 return SCM_UNSPECIFIED
;
913 SCM_DEFINE (scm_bind
, "bind", 2, 1, 1,
914 (SCM sock
, SCM fam_or_sockaddr
, SCM address
, SCM args
),
915 "Assign an address to the socket port @var{sock}.\n"
916 "Generally this only needs to be done for server sockets,\n"
917 "so they know where to look for incoming connections. A socket\n"
918 "without an address will be assigned one automatically when it\n"
919 "starts communicating.\n\n"
920 "The format of @var{address} and @var{args} depends\n"
921 "on the family of the socket.\n\n"
922 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
923 "is specified and must be a string with the filename where\n"
924 "the socket is to be created.\n\n"
925 "For a socket of family @code{AF_INET}, @var{address}\n"
926 "must be an integer IPv4 address and @var{args}\n"
927 "must be a single integer port number.\n\n"
928 "The values of the following variables can also be used for\n"
930 "@defvar INADDR_ANY\n"
931 "Allow connections from any address.\n"
933 "@defvar INADDR_LOOPBACK\n"
934 "The address of the local host using the loopback device.\n"
936 "@defvar INADDR_BROADCAST\n"
937 "The broadcast address on the local network.\n"
939 "@defvar INADDR_NONE\n"
942 "For a socket of family @code{AF_INET6}, @var{address}\n"
943 "must be an integer IPv6 address and @var{args}\n"
944 "may be up to three integers:\n"
945 "port [flowinfo] [scope_id],\n"
946 "where flowinfo and scope_id default to zero.\n\n"
947 "Alternatively, the second argument can be a socket address object "
948 "as returned by @code{make-socket-address}, in which case the "
949 "no additional arguments should be passed.\n\n"
950 "The return value is unspecified.")
951 #define FUNC_NAME s_scm_bind
953 struct sockaddr
*soka
;
957 sock
= SCM_COERCE_OUTPORT (sock
);
958 SCM_VALIDATE_OPFPORT (1, sock
);
959 fd
= SCM_FPORT_FDES (sock
);
961 if (address
== SCM_UNDEFINED
)
962 /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
963 `socket address' object. */
964 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
966 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
967 &args
, 3, FUNC_NAME
, &size
);
970 if (bind (fd
, soka
, size
) == -1)
972 int save_errno
= errno
;
979 return SCM_UNSPECIFIED
;
983 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
984 (SCM sock
, SCM backlog
),
985 "Enable @var{sock} to accept connection\n"
986 "requests. @var{backlog} is an integer specifying\n"
987 "the maximum length of the queue for pending connections.\n"
988 "If the queue fills, new clients will fail to connect until\n"
989 "the server calls @code{accept} to accept a connection from\n"
991 "The return value is unspecified.")
992 #define FUNC_NAME s_scm_listen
995 sock
= SCM_COERCE_OUTPORT (sock
);
996 SCM_VALIDATE_OPFPORT (1, sock
);
997 fd
= SCM_FPORT_FDES (sock
);
998 if (listen (fd
, scm_to_int (backlog
)) == -1)
1000 return SCM_UNSPECIFIED
;
1004 /* Put the components of a sockaddr into a new SCM vector. */
1005 static SCM_C_INLINE_KEYWORD SCM
1006 _scm_from_sockaddr (const struct sockaddr
*address
, unsigned addr_size
,
1009 short int fam
= address
->sa_family
;
1010 SCM result
=SCM_EOL
;
1017 const struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
1019 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
1021 SCM_SIMPLE_VECTOR_SET(result
, 0,
1022 scm_from_short (fam
));
1023 SCM_SIMPLE_VECTOR_SET(result
, 1,
1024 scm_from_ulong (ntohl (nad
->sin_addr
.s_addr
)));
1025 SCM_SIMPLE_VECTOR_SET(result
, 2,
1026 scm_from_ushort (ntohs (nad
->sin_port
)));
1032 const struct sockaddr_in6
*nad
= (struct sockaddr_in6
*) address
;
1034 result
= scm_c_make_vector (5, SCM_UNSPECIFIED
);
1035 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1036 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_ipv6 (nad
->sin6_addr
.s6_addr
));
1037 SCM_SIMPLE_VECTOR_SET(result
, 2, scm_from_ushort (ntohs (nad
->sin6_port
)));
1038 SCM_SIMPLE_VECTOR_SET(result
, 3, scm_from_uint32 (nad
->sin6_flowinfo
));
1039 #ifdef HAVE_SIN6_SCOPE_ID
1040 SCM_SIMPLE_VECTOR_SET(result
, 4, scm_from_ulong (nad
->sin6_scope_id
));
1042 SCM_SIMPLE_VECTOR_SET(result
, 4, SCM_INUM0
);
1047 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1050 const struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
1052 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
1054 SCM_SIMPLE_VECTOR_SET(result
, 0, scm_from_short (fam
));
1055 /* When addr_size is not enough to cover sun_path, do not try
1057 if (addr_size
<= offsetof (struct sockaddr_un
, sun_path
))
1058 SCM_SIMPLE_VECTOR_SET(result
, 1, SCM_BOOL_F
);
1060 SCM_SIMPLE_VECTOR_SET(result
, 1, scm_from_locale_string (nad
->sun_path
));
1065 result
= SCM_UNSPECIFIED
;
1066 scm_misc_error (proc
, "unrecognised address family: ~A",
1067 scm_list_1 (scm_from_int (fam
)));
1073 /* The publicly-visible function. Return a Scheme object representing
1074 ADDRESS, an address of ADDR_SIZE bytes. */
1076 scm_from_sockaddr (const struct sockaddr
*address
, unsigned addr_size
)
1078 return (_scm_from_sockaddr (address
, addr_size
, "scm_from_sockaddr"));
1081 /* Convert ADDRESS, an address object returned by either
1082 `scm_from_sockaddr ()' or `scm_make_socket_address ()', into its C
1083 representation. On success, a non-NULL pointer is returned and
1084 ADDRESS_SIZE is updated to the actual size (in bytes) of the returned
1085 address. The result must eventually be freed using `free ()'. */
1087 scm_to_sockaddr (SCM address
, size_t *address_size
)
1088 #define FUNC_NAME "scm_to_sockaddr"
1091 struct sockaddr
*c_address
= NULL
;
1093 SCM_VALIDATE_VECTOR (1, address
);
1096 family
= scm_to_short (SCM_SIMPLE_VECTOR_REF (address
, 0));
1102 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 3)
1103 scm_misc_error (FUNC_NAME
,
1104 "invalid inet address representation: ~A",
1105 scm_list_1 (address
));
1108 struct sockaddr_in c_inet
;
1110 c_inet
.sin_addr
.s_addr
=
1111 htonl (scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 1)));
1113 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1114 c_inet
.sin_family
= AF_INET
;
1116 *address_size
= sizeof (c_inet
);
1117 c_address
= scm_malloc (sizeof (c_inet
));
1118 memcpy (c_address
, &c_inet
, sizeof (c_inet
));
1127 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 5)
1128 scm_misc_error (FUNC_NAME
, "invalid inet6 address representation: ~A",
1129 scm_list_1 (address
));
1132 struct sockaddr_in6 c_inet6
;
1134 scm_to_ipv6 (c_inet6
.sin6_addr
.s6_addr
, address
);
1136 htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address
, 2)));
1137 c_inet6
.sin6_flowinfo
=
1138 scm_to_uint32 (SCM_SIMPLE_VECTOR_REF (address
, 3));
1139 #ifdef HAVE_SIN6_SCOPE_ID
1140 c_inet6
.sin6_scope_id
=
1141 scm_to_ulong (SCM_SIMPLE_VECTOR_REF (address
, 4));
1144 c_inet6
.sin6_family
= AF_INET6
;
1146 *address_size
= sizeof (c_inet6
);
1147 c_address
= scm_malloc (sizeof (c_inet6
));
1148 memcpy (c_address
, &c_inet6
, sizeof (c_inet6
));
1155 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
1158 if (SCM_SIMPLE_VECTOR_LENGTH (address
) != 2)
1159 scm_misc_error (FUNC_NAME
, "invalid unix address representation: ~A",
1160 scm_list_1 (address
));
1164 size_t path_len
= 0;
1166 path
= SCM_SIMPLE_VECTOR_REF (address
, 1);
1167 if ((!scm_is_string (path
)) && (path
!= SCM_BOOL_F
))
1168 scm_misc_error (FUNC_NAME
, "invalid unix address "
1169 "path: ~A", scm_list_1 (path
));
1172 struct sockaddr_un c_unix
;
1174 if (path
== SCM_BOOL_F
)
1177 path_len
= scm_c_string_length (path
);
1179 #ifdef UNIX_PATH_MAX
1180 if (path_len
>= UNIX_PATH_MAX
)
1182 /* We can hope that this limit will eventually vanish, at least on GNU.
1183 However, currently, while glibc doesn't define `UNIX_PATH_MAX', it
1184 documents it has being limited to 108 bytes. */
1185 if (path_len
>= sizeof (c_unix
.sun_path
))
1187 scm_misc_error (FUNC_NAME
, "unix address path "
1188 "too long: ~A", scm_list_1 (path
));
1193 scm_to_locale_stringbuf (path
, c_unix
.sun_path
,
1194 #ifdef UNIX_PATH_MAX
1197 sizeof (c_unix
.sun_path
));
1199 c_unix
.sun_path
[path_len
] = '\0';
1202 if (strlen (c_unix
.sun_path
) != path_len
)
1203 scm_misc_error (FUNC_NAME
, "unix address path "
1204 "contains nul characters: ~A",
1208 c_unix
.sun_path
[0] = '\0';
1210 c_unix
.sun_family
= AF_UNIX
;
1212 *address_size
= SUN_LEN (&c_unix
);
1213 c_address
= scm_malloc (sizeof (c_unix
));
1214 memcpy (c_address
, &c_unix
, sizeof (c_unix
));
1224 scm_misc_error (FUNC_NAME
, "unrecognised address family: ~A",
1225 scm_list_1 (scm_from_ushort (family
)));
1233 /* Return a newly-allocated `sockaddr' structure that reflects ADDRESS, being
1234 an address of family FAMILY, with the family-specific parameters ARGS (see
1235 the description of `connect' for details). The returned structure may be
1236 freed using `free ()'. */
1238 scm_c_make_socket_address (SCM family
, SCM address
, SCM args
,
1239 size_t *address_size
)
1242 struct sockaddr
*soka
;
1244 soka
= scm_fill_sockaddr (scm_to_ushort (family
), address
, &args
, 1,
1245 "scm_c_make_socket_address", &size
);
1250 SCM_DEFINE (scm_make_socket_address
, "make-socket-address", 2, 0, 1,
1251 (SCM family
, SCM address
, SCM args
),
1252 "Return a Scheme address object that reflects @var{address}, "
1253 "being an address of family @var{family}, with the "
1254 "family-specific parameters @var{args} (see the description of "
1255 "@code{connect} for details).")
1256 #define FUNC_NAME s_scm_make_socket_address
1258 struct sockaddr
*c_address
;
1259 size_t c_address_size
;
1261 c_address
= scm_c_make_socket_address (family
, address
, args
,
1266 return (scm_from_sockaddr (c_address
, c_address_size
));
1271 /* calculate the size of a buffer large enough to hold any supported
1272 sockaddr type. if the buffer isn't large enough, certain system
1273 calls will return a truncated address. */
1275 #if defined (HAVE_UNIX_DOMAIN_SOCKETS)
1276 #define MAX_SIZE_UN sizeof (struct sockaddr_un)
1278 #define MAX_SIZE_UN 0
1281 #if defined (HAVE_IPV6)
1282 #define MAX_SIZE_IN6 sizeof (struct sockaddr_in6)
1284 #define MAX_SIZE_IN6 0
1287 #define MAX_ADDR_SIZE max (max (sizeof (struct sockaddr_in), MAX_SIZE_IN6),\
1290 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
1292 "Accept a connection on a bound, listening socket.\n"
1294 "are no pending connections in the queue, wait until\n"
1295 "one is available unless the non-blocking option has been\n"
1296 "set on the socket.\n\n"
1297 "The return value is a\n"
1298 "pair in which the @emph{car} is a new socket port for the\n"
1300 "the @emph{cdr} is an object with address information about the\n"
1301 "client which initiated the connection.\n\n"
1302 "@var{sock} does not become part of the\n"
1303 "connection and will continue to accept new requests.")
1304 #define FUNC_NAME s_scm_accept
1310 socklen_t addr_size
= MAX_ADDR_SIZE
;
1311 char max_addr
[MAX_ADDR_SIZE
];
1312 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1314 sock
= SCM_COERCE_OUTPORT (sock
);
1315 SCM_VALIDATE_OPFPORT (1, sock
);
1316 fd
= SCM_FPORT_FDES (sock
);
1317 newfd
= accept (fd
, addr
, &addr_size
);
1320 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
1321 address
= _scm_from_sockaddr (addr
, addr_size
, FUNC_NAME
);
1322 return scm_cons (newsock
, address
);
1326 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
1328 "Return the address of @var{sock}, in the same form as the\n"
1329 "object returned by @code{accept}. On many systems the address\n"
1330 "of a socket in the @code{AF_FILE} namespace cannot be read.")
1331 #define FUNC_NAME s_scm_getsockname
1334 socklen_t addr_size
= MAX_ADDR_SIZE
;
1335 char max_addr
[MAX_ADDR_SIZE
];
1336 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1338 sock
= SCM_COERCE_OUTPORT (sock
);
1339 SCM_VALIDATE_OPFPORT (1, sock
);
1340 fd
= SCM_FPORT_FDES (sock
);
1341 if (getsockname (fd
, addr
, &addr_size
) == -1)
1343 return _scm_from_sockaddr (addr
, addr_size
, FUNC_NAME
);
1347 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
1349 "Return the address that @var{sock}\n"
1350 "is connected to, in the same form as the object returned by\n"
1351 "@code{accept}. On many systems the address of a socket in the\n"
1352 "@code{AF_FILE} namespace cannot be read.")
1353 #define FUNC_NAME s_scm_getpeername
1356 socklen_t addr_size
= MAX_ADDR_SIZE
;
1357 char max_addr
[MAX_ADDR_SIZE
];
1358 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1360 sock
= SCM_COERCE_OUTPORT (sock
);
1361 SCM_VALIDATE_OPFPORT (1, sock
);
1362 fd
= SCM_FPORT_FDES (sock
);
1363 if (getpeername (fd
, addr
, &addr_size
) == -1)
1365 return _scm_from_sockaddr (addr
, addr_size
, FUNC_NAME
);
1369 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
1370 (SCM sock
, SCM buf
, SCM flags
),
1371 "Receive data from a socket port.\n"
1372 "@var{sock} must already\n"
1373 "be bound to the address from which data is to be received.\n"
1374 "@var{buf} is a string into which\n"
1375 "the data will be written. The size of @var{buf} limits\n"
1377 "data which can be received: in the case of packet\n"
1378 "protocols, if a packet larger than this limit is encountered\n"
1380 "will be irrevocably lost.\n\n"
1381 "The optional @var{flags} argument is a value or\n"
1382 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1383 "The value returned is the number of bytes read from the\n"
1385 "Note that the data is read directly from the socket file\n"
1387 "any unread buffered port data is ignored.")
1388 #define FUNC_NAME s_scm_recv
1396 SCM_VALIDATE_OPFPORT (1, sock
);
1397 SCM_VALIDATE_STRING (2, buf
);
1398 if (SCM_UNBNDP (flags
))
1401 flg
= scm_to_int (flags
);
1402 fd
= SCM_FPORT_FDES (sock
);
1404 len
= scm_i_string_length (buf
);
1405 dest
= scm_i_string_writable_chars (buf
);
1406 SCM_SYSCALL (rv
= recv (fd
, dest
, len
, flg
));
1407 scm_i_string_stop_writing ();
1412 scm_remember_upto_here_1 (buf
);
1413 return scm_from_int (rv
);
1417 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
1418 (SCM sock
, SCM message
, SCM flags
),
1419 "Transmit the string @var{message} on a socket port @var{sock}.\n"
1420 "@var{sock} must already be bound to a destination address. The\n"
1421 "value returned is the number of bytes transmitted --\n"
1422 "it's possible for\n"
1423 "this to be less than the length of @var{message}\n"
1424 "if the socket is\n"
1425 "set to be non-blocking. The optional @var{flags} argument\n"
1427 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1428 "Note that the data is written directly to the socket\n"
1429 "file descriptor:\n"
1430 "any unflushed buffered port data is ignored.")
1431 #define FUNC_NAME s_scm_send
1439 sock
= SCM_COERCE_OUTPORT (sock
);
1440 SCM_VALIDATE_OPFPORT (1, sock
);
1441 SCM_VALIDATE_STRING (2, message
);
1442 if (SCM_UNBNDP (flags
))
1445 flg
= scm_to_int (flags
);
1446 fd
= SCM_FPORT_FDES (sock
);
1448 len
= scm_i_string_length (message
);
1449 src
= scm_i_string_writable_chars (message
);
1450 SCM_SYSCALL (rv
= send (fd
, src
, len
, flg
));
1451 scm_i_string_stop_writing ();
1456 scm_remember_upto_here_1 (message
);
1457 return scm_from_int (rv
);
1461 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
1462 (SCM sock
, SCM str
, SCM flags
, SCM start
, SCM end
),
1463 "Return data from the socket port @var{sock} and also\n"
1464 "information about where the data was received from.\n"
1465 "@var{sock} must already be bound to the address from which\n"
1466 "data is to be received. @code{str}, is a string into which the\n"
1467 "data will be written. The size of @var{str} limits the amount\n"
1468 "of data which can be received: in the case of packet protocols,\n"
1469 "if a packet larger than this limit is encountered then some\n"
1470 "data will be irrevocably lost.\n\n"
1471 "The optional @var{flags} argument is a value or bitwise OR of\n"
1472 "@code{MSG_OOB}, @code{MSG_PEEK}, @code{MSG_DONTROUTE} etc.\n\n"
1473 "The value returned is a pair: the @emph{car} is the number of\n"
1474 "bytes read from the socket and the @emph{cdr} an address object\n"
1475 "in the same form as returned by @code{accept}. The address\n"
1476 "will given as @code{#f} if not available, as is usually the\n"
1477 "case for stream sockets.\n\n"
1478 "The @var{start} and @var{end} arguments specify a substring of\n"
1479 "@var{str} to which the data should be written.\n\n"
1480 "Note that the data is read directly from the socket file\n"
1481 "descriptor: any unread buffered port data is ignored.")
1482 #define FUNC_NAME s_scm_recvfrom
1491 socklen_t addr_size
= MAX_ADDR_SIZE
;
1492 char max_addr
[MAX_ADDR_SIZE
];
1493 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1495 SCM_VALIDATE_OPFPORT (1, sock
);
1496 fd
= SCM_FPORT_FDES (sock
);
1498 SCM_VALIDATE_STRING (2, str
);
1499 scm_i_get_substring_spec (scm_i_string_length (str
),
1500 start
, &offset
, end
, &cend
);
1502 if (SCM_UNBNDP (flags
))
1505 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
1507 /* recvfrom will not necessarily return an address. usually nothing
1508 is returned for stream sockets. */
1509 buf
= scm_i_string_writable_chars (str
);
1510 addr
->sa_family
= AF_UNSPEC
;
1511 SCM_SYSCALL (rv
= recvfrom (fd
, buf
+ offset
,
1514 scm_i_string_stop_writing ();
1518 if (addr
->sa_family
!= AF_UNSPEC
)
1519 address
= _scm_from_sockaddr (addr
, addr_size
, FUNC_NAME
);
1521 address
= SCM_BOOL_F
;
1523 scm_remember_upto_here_1 (str
);
1524 return scm_cons (scm_from_int (rv
), address
);
1528 SCM_DEFINE (scm_sendto
, "sendto", 3, 1, 1,
1529 (SCM sock
, SCM message
, SCM fam_or_sockaddr
, SCM address
, SCM args_and_flags
),
1530 "Transmit the string @var{message} on the socket port\n"
1532 "destination address is specified using the @var{fam},\n"
1533 "@var{address} and\n"
1534 "@var{args_and_flags} arguments, or just a socket address object "
1535 "returned by @code{make-socket-address}, in a similar way to the\n"
1536 "@code{connect} procedure. @var{args_and_flags} contains\n"
1537 "the usual connection arguments optionally followed by\n"
1538 "a flags argument, which is a value or\n"
1539 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1540 "The value returned is the number of bytes transmitted --\n"
1541 "it's possible for\n"
1542 "this to be less than the length of @var{message} if the\n"
1544 "set to be non-blocking.\n"
1545 "Note that the data is written directly to the socket\n"
1546 "file descriptor:\n"
1547 "any unflushed buffered port data is ignored.")
1548 #define FUNC_NAME s_scm_sendto
1553 struct sockaddr
*soka
;
1556 sock
= SCM_COERCE_OUTPORT (sock
);
1557 SCM_VALIDATE_FPORT (1, sock
);
1558 SCM_VALIDATE_STRING (2, message
);
1559 fd
= SCM_FPORT_FDES (sock
);
1561 if (!scm_is_number (fam_or_sockaddr
))
1563 /* FAM_OR_SOCKADDR must actually be a `socket address' object. This
1564 means that the following arguments, i.e. ADDRESS and those listed in
1565 ARGS_AND_FLAGS, are the `MSG_' flags. */
1566 soka
= scm_to_sockaddr (fam_or_sockaddr
, &size
);
1567 if (address
!= SCM_UNDEFINED
)
1568 args_and_flags
= scm_cons (address
, args_and_flags
);
1571 soka
= scm_fill_sockaddr (scm_to_int (fam_or_sockaddr
), address
,
1572 &args_and_flags
, 3, FUNC_NAME
, &size
);
1574 if (scm_is_null (args_and_flags
))
1578 SCM_VALIDATE_CONS (5, args_and_flags
);
1579 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
1581 SCM_SYSCALL (rv
= sendto (fd
,
1582 scm_i_string_chars (message
),
1583 scm_i_string_length (message
),
1587 int save_errno
= errno
;
1594 scm_remember_upto_here_1 (message
);
1595 return scm_from_int (rv
);
1604 /* protocol families. */
1606 scm_c_define ("AF_UNSPEC", scm_from_int (AF_UNSPEC
));
1609 scm_c_define ("AF_UNIX", scm_from_int (AF_UNIX
));
1612 scm_c_define ("AF_INET", scm_from_int (AF_INET
));
1615 scm_c_define ("AF_INET6", scm_from_int (AF_INET6
));
1619 scm_c_define ("PF_UNSPEC", scm_from_int (PF_UNSPEC
));
1622 scm_c_define ("PF_UNIX", scm_from_int (PF_UNIX
));
1625 scm_c_define ("PF_INET", scm_from_int (PF_INET
));
1628 scm_c_define ("PF_INET6", scm_from_int (PF_INET6
));
1631 /* standard addresses. */
1633 scm_c_define ("INADDR_ANY", scm_from_ulong (INADDR_ANY
));
1635 #ifdef INADDR_BROADCAST
1636 scm_c_define ("INADDR_BROADCAST", scm_from_ulong (INADDR_BROADCAST
));
1639 scm_c_define ("INADDR_NONE", scm_from_ulong (INADDR_NONE
));
1641 #ifdef INADDR_LOOPBACK
1642 scm_c_define ("INADDR_LOOPBACK", scm_from_ulong (INADDR_LOOPBACK
));
1647 SOCK_PACKET is deliberately omitted, the GNU/Linux socket(2) and
1648 packet(7) advise that it's obsolete and strongly deprecated. */
1651 scm_c_define ("SOCK_STREAM", scm_from_int (SOCK_STREAM
));
1654 scm_c_define ("SOCK_DGRAM", scm_from_int (SOCK_DGRAM
));
1656 #ifdef SOCK_SEQPACKET
1657 scm_c_define ("SOCK_SEQPACKET", scm_from_int (SOCK_SEQPACKET
));
1660 scm_c_define ("SOCK_RAW", scm_from_int (SOCK_RAW
));
1663 scm_c_define ("SOCK_RDM", scm_from_int (SOCK_RDM
));
1666 /* setsockopt level.
1668 SOL_IP, SOL_TCP and SOL_UDP are defined on gnu/linux, but not on for
1669 instance NetBSD. We define IPPROTOs because that's what the posix spec
1670 shows in its example at
1672 http://www.opengroup.org/onlinepubs/007904975/functions/getsockopt.html
1675 scm_c_define ("SOL_SOCKET", scm_from_int (SOL_SOCKET
));
1678 scm_c_define ("IPPROTO_IP", scm_from_int (IPPROTO_IP
));
1681 scm_c_define ("IPPROTO_TCP", scm_from_int (IPPROTO_TCP
));
1684 scm_c_define ("IPPROTO_UDP", scm_from_int (IPPROTO_UDP
));
1687 /* setsockopt names. */
1689 scm_c_define ("SO_DEBUG", scm_from_int (SO_DEBUG
));
1692 scm_c_define ("SO_REUSEADDR", scm_from_int (SO_REUSEADDR
));
1695 scm_c_define ("SO_STYLE", scm_from_int (SO_STYLE
));
1698 scm_c_define ("SO_TYPE", scm_from_int (SO_TYPE
));
1701 scm_c_define ("SO_ERROR", scm_from_int (SO_ERROR
));
1704 scm_c_define ("SO_DONTROUTE", scm_from_int (SO_DONTROUTE
));
1707 scm_c_define ("SO_BROADCAST", scm_from_int (SO_BROADCAST
));
1710 scm_c_define ("SO_SNDBUF", scm_from_int (SO_SNDBUF
));
1713 scm_c_define ("SO_RCVBUF", scm_from_int (SO_RCVBUF
));
1716 scm_c_define ("SO_KEEPALIVE", scm_from_int (SO_KEEPALIVE
));
1719 scm_c_define ("SO_OOBINLINE", scm_from_int (SO_OOBINLINE
));
1722 scm_c_define ("SO_NO_CHECK", scm_from_int (SO_NO_CHECK
));
1725 scm_c_define ("SO_PRIORITY", scm_from_int (SO_PRIORITY
));
1728 scm_c_define ("SO_LINGER", scm_from_int (SO_LINGER
));
1731 /* recv/send options. */
1733 scm_c_define ("MSG_OOB", scm_from_int (MSG_OOB
));
1736 scm_c_define ("MSG_PEEK", scm_from_int (MSG_PEEK
));
1738 #ifdef MSG_DONTROUTE
1739 scm_c_define ("MSG_DONTROUTE", scm_from_int (MSG_DONTROUTE
));
1743 scm_i_init_socket_Win32 ();
1746 #ifdef IP_ADD_MEMBERSHIP
1747 scm_c_define ("IP_ADD_MEMBERSHIP", scm_from_int (IP_ADD_MEMBERSHIP
));
1748 scm_c_define ("IP_DROP_MEMBERSHIP", scm_from_int (IP_DROP_MEMBERSHIP
));
1751 scm_add_feature ("socket");
1753 #include "libguile/socket.x"