1 /* Copyright (C) 1996,1997,1998,2000,2001 Free Software Foundation, Inc.
3 * This program is free software; you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation; either version 2, or (at your option)
8 * This program 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
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this software; see the file COPYING. If not, write to
15 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
16 * Boston, MA 02111-1307 USA
18 * As a special exception, the Free Software Foundation gives permission
19 * for additional uses of the text contained in its release of GUILE.
21 * The exception is that, if you link the GUILE library with other files
22 * to produce an executable, this does not by itself cause the
23 * resulting executable to be covered by the GNU General Public License.
24 * Your use of that executable is in no way restricted on account of
25 * linking the GUILE library code into it.
27 * This exception does not however invalidate any other reasons why
28 * the executable file might be covered by the GNU General Public License.
30 * This exception applies only to the code released by the
31 * Free Software Foundation under the name GUILE. If you copy
32 * code from other Free Software Foundation releases into a copy of
33 * GUILE, as the General Public License permits, the exception does
34 * not apply to the code that you add in this way. To avoid misleading
35 * anyone as to the status of such modified files, you must delete
36 * this exception notice from them.
38 * If you write modifications of your own for GUILE, it is your choice
39 * whether to permit this exception to apply to your modifications.
40 * If you do not wish that, delete this exception notice. */
47 #include "libguile/_scm.h"
48 #include "libguile/unif.h"
49 #include "libguile/feature.h"
50 #include "libguile/fports.h"
51 #include "libguile/strings.h"
52 #include "libguile/vectors.h"
54 #include "libguile/validate.h"
55 #include "libguile/socket.h"
58 #include "win32-socket.h"
70 #include <sys/types.h>
71 #if defined (HAVE_WINSOCK2_H) \
72 && !(defined (__CYGWIN32__) || defined (__CYGWIN__))
75 #include <sys/socket.h>
76 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
79 #include <netinet/in.h>
81 #include <arpa/inet.h>
84 #if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
85 #define SUN_LEN(ptr) ((size_t) (((struct sockaddr_un *) 0)->sun_path) \
86 + strlen ((ptr)->sun_path))
89 #if !defined (HAVE_UINT32_T)
91 typedef unsigned int uint32_t;
92 #elif SIZEOF_LONG == 4
93 typedef unsigned long uint32_t;
95 #error can not define uint32_t
99 /* we are not currently using socklen_t. it's not defined on all systems,
100 so would need to be checked by configure. in the meantime, plain
101 int is the best alternative. */
105 SCM_DEFINE (scm_htons
, "htons", 1, 0, 0,
107 "Convert a 16 bit quantity from host to network byte ordering.\n"
108 "@var{value} is packed into 2 bytes, which are then converted\n"
109 "and returned as a new integer.")
110 #define FUNC_NAME s_scm_htons
114 SCM_VALIDATE_INUM_COPY (1, value
, c_in
);
115 if (c_in
!= SCM_INUM (value
))
116 SCM_OUT_OF_RANGE (1, value
);
118 return SCM_MAKINUM (htons (c_in
));
122 SCM_DEFINE (scm_ntohs
, "ntohs", 1, 0, 0,
124 "Convert a 16 bit quantity from network to host byte ordering.\n"
125 "@var{value} is packed into 2 bytes, which are then converted\n"
126 "and returned as a new integer.")
127 #define FUNC_NAME s_scm_ntohs
131 SCM_VALIDATE_INUM_COPY (1, value
, c_in
);
132 if (c_in
!= SCM_INUM (value
))
133 SCM_OUT_OF_RANGE (1, value
);
135 return SCM_MAKINUM (ntohs (c_in
));
139 SCM_DEFINE (scm_htonl
, "htonl", 1, 0, 0,
141 "Convert a 32 bit quantity from host to network byte ordering.\n"
142 "@var{value} is packed into 4 bytes, which are then converted\n"
143 "and returned as a new integer.")
144 #define FUNC_NAME s_scm_htonl
146 uint32_t c_in
= SCM_NUM2ULONG (1, value
);
148 return scm_ulong2num (htonl (c_in
));
152 SCM_DEFINE (scm_ntohl
, "ntohl", 1, 0, 0,
154 "Convert a 32 bit quantity from network to host byte ordering.\n"
155 "@var{value} is packed into 4 bytes, which are then converted\n"
156 "and returned as a new integer.")
157 #define FUNC_NAME s_scm_ntohl
159 uint32_t c_in
= SCM_NUM2ULONG (1, value
);
161 return scm_ulong2num (ntohl (c_in
));
165 #ifndef HAVE_INET_ATON
166 /* for our definition in inet_aton.c, not usually needed. */
167 extern int inet_aton ();
170 SCM_DEFINE (scm_inet_aton
, "inet-aton", 1, 0, 0,
172 "Convert an IPv4 Internet address from printable string\n"
173 "(dotted decimal notation) to an integer. E.g.,\n\n"
175 "(inet-aton \"127.0.0.1\") @result{} 2130706433\n"
177 #define FUNC_NAME s_scm_inet_aton
181 SCM_VALIDATE_STRING (1, address
);
182 if (inet_aton (SCM_STRING_CHARS (address
), &soka
) == 0)
183 SCM_MISC_ERROR ("bad address", SCM_EOL
);
184 return scm_ulong2num (ntohl (soka
.s_addr
));
189 SCM_DEFINE (scm_inet_ntoa
, "inet-ntoa", 1, 0, 0,
191 "Convert an IPv4 Internet address to a printable\n"
192 "(dotted decimal notation) string. E.g.,\n\n"
194 "(inet-ntoa 2130706433) @result{} \"127.0.0.1\"\n"
196 #define FUNC_NAME s_scm_inet_ntoa
201 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, inetid
));
202 s
= inet_ntoa (addr
);
203 answer
= scm_mem2string (s
, strlen (s
));
208 #ifdef HAVE_INET_NETOF
209 SCM_DEFINE (scm_inet_netof
, "inet-netof", 1, 0, 0,
211 "Return the network number part of the given IPv4\n"
212 "Internet address. E.g.,\n\n"
214 "(inet-netof 2130706433) @result{} 127\n"
216 #define FUNC_NAME s_scm_inet_netof
219 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
220 return scm_ulong2num ((unsigned long) inet_netof (addr
));
225 #ifdef HAVE_INET_LNAOF
226 SCM_DEFINE (scm_lnaof
, "inet-lnaof", 1, 0, 0,
228 "Return the local-address-with-network part of the given\n"
229 "IPv4 Internet address, using the obsolete class A/B/C system.\n"
232 "(inet-lnaof 2130706433) @result{} 1\n"
234 #define FUNC_NAME s_scm_lnaof
237 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
238 return scm_ulong2num ((unsigned long) inet_lnaof (addr
));
243 #ifdef HAVE_INET_MAKEADDR
244 SCM_DEFINE (scm_inet_makeaddr
, "inet-makeaddr", 2, 0, 0,
246 "Make an IPv4 Internet address by combining the network number\n"
247 "@var{net} with the local-address-within-network number\n"
248 "@var{lna}. E.g.,\n\n"
250 "(inet-makeaddr 127 1) @result{} 2130706433\n"
252 #define FUNC_NAME s_scm_inet_makeaddr
255 unsigned long netnum
;
256 unsigned long lnanum
;
258 netnum
= SCM_NUM2ULONG (1, net
);
259 lnanum
= SCM_NUM2ULONG (2, lna
);
260 addr
= inet_makeaddr (netnum
, lnanum
);
261 return scm_ulong2num (ntohl (addr
.s_addr
));
268 /* flip a 128 bit IPv6 address between host and network order. */
269 #ifdef WORDS_BIGENDIAN
270 #define FLIP_NET_HOST_128(addr)
272 #define FLIP_NET_HOST_128(addr)\
276 for (i = 0; i < 8; i++)\
280 (addr)[i] = (addr)[15 - i];\
286 /* convert a 128 bit IPv6 address in network order to a host ordered
288 static SCM
ipv6_net_to_num (const char *src
)
290 int big_digits
= 128 / SCM_BITSPERDIG
;
291 const int bytes_per_dig
= SCM_BITSPERDIG
/ 8;
296 memcpy (addr
, src
, 16);
297 /* get rid of leading zeros. */
298 while (big_digits
> 0)
302 memcpy (&test
, ptr
, bytes_per_dig
);
305 ptr
+= bytes_per_dig
;
308 FLIP_NET_HOST_128 (addr
);
309 if (big_digits
* bytes_per_dig
<= sizeof (unsigned long))
311 /* this is just so that we use INUM where possible. */
312 unsigned long l_addr
;
314 memcpy (&l_addr
, addr
, sizeof (unsigned long));
315 result
= scm_ulong2num (l_addr
);
319 result
= scm_i_mkbig (big_digits
, 0);
320 memcpy (SCM_BDIGITS (result
), addr
, big_digits
* bytes_per_dig
);
325 /* convert a host ordered SCM integer to a 128 bit IPv6 address in
327 static void ipv6_num_to_net (SCM src
, char *dst
)
331 uint32_t addr
= htonl (SCM_INUM (src
));
334 memcpy (dst
+ 12, &addr
, 4);
339 memcpy (dst
, SCM_BDIGITS (src
),
340 SCM_NUMDIGS (src
) * (SCM_BITSPERDIG
/ 8));
341 FLIP_NET_HOST_128 (dst
);
345 /* check that an SCM variable contains an IPv6 integer address. */
346 #define VALIDATE_INET6(which_arg, address)\
347 if (SCM_INUMP (address))\
348 SCM_ASSERT_RANGE (which_arg, address, SCM_INUM (address) >= 0);\
351 SCM_VALIDATE_BIGINT (which_arg, address);\
352 SCM_ASSERT_RANGE (which_arg, address,\
353 !SCM_BIGSIGN (address)\
355 * SCM_NUMDIGS (address) <= 128));\
358 #ifdef HAVE_INET_PTON
359 SCM_DEFINE (scm_inet_pton
, "inet-pton", 2, 0, 0,
360 (SCM family
, SCM address
),
361 "Convert a string containing a printable network address to\n"
362 "an integer address. Note that unlike the C version of this\n"
364 "the result is an integer with normal host byte ordering.\n"
365 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
367 "(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
368 "(inet-pton AF_INET6 \"::1\") @result{} 1\n"
370 #define FUNC_NAME s_scm_inet_pton
377 SCM_VALIDATE_INUM_COPY (1, family
, af
);
378 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
379 SCM_VALIDATE_STRING_COPY (2, address
, src
);
380 rv
= inet_pton (af
, src
, dst
);
384 SCM_MISC_ERROR ("Bad address", SCM_EOL
);
386 return scm_ulong2num (ntohl (*(uint32_t *) dst
));
388 return ipv6_net_to_num ((char *) dst
);
393 #ifdef HAVE_INET_NTOP
394 SCM_DEFINE (scm_inet_ntop
, "inet-ntop", 2, 0, 0,
395 (SCM family
, SCM address
),
396 "Convert a network address into a printable string.\n"
397 "Note that unlike the C version of this function,\n"
398 "the input is an integer with normal host byte ordering.\n"
399 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
401 "(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
402 "(inet-ntop AF_INET6 (- (expt 2 128) 1)) @result{}\n"
403 "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\n"
405 #define FUNC_NAME s_scm_inet_ntop
408 #ifdef INET6_ADDRSTRLEN
409 char dst
[INET6_ADDRSTRLEN
];
415 SCM_VALIDATE_INUM_COPY (1, family
, af
);
416 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
418 *(uint32_t *) addr6
= htonl (SCM_NUM2ULONG (2, address
));
421 VALIDATE_INET6 (2, address
);
422 ipv6_num_to_net (address
, addr6
);
424 if (inet_ntop (af
, &addr6
, dst
, sizeof dst
) == NULL
)
426 return scm_makfrom0str (dst
);
431 #endif /* HAVE_IPV6 */
433 SCM_SYMBOL (sym_socket
, "socket");
435 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
437 SCM_DEFINE (scm_socket
, "socket", 3, 0, 0,
438 (SCM family
, SCM style
, SCM proto
),
439 "Return a new socket port of the type specified by @var{family},\n"
440 "@var{style} and @var{proto}. All three parameters are\n"
441 "integers. Supported values for @var{family} are\n"
442 "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
443 "Typical values for @var{style} are @code{SOCK_STREAM},\n"
444 "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
445 "@var{proto} can be obtained from a protocol name using\n"
446 "@code{getprotobyname}. A value of zero specifies the default\n"
447 "protocol, which is usually right.\n\n"
448 "A single socket port cannot by used for communication until it\n"
449 "has been connected to another socket.")
450 #define FUNC_NAME s_scm_socket
454 SCM_VALIDATE_INUM (1, family
);
455 SCM_VALIDATE_INUM (2, style
);
456 SCM_VALIDATE_INUM (3, proto
);
457 fd
= socket (SCM_INUM (family
), SCM_INUM (style
), SCM_INUM (proto
));
460 return SCM_SOCK_FD_TO_PORT (fd
);
464 #ifdef HAVE_SOCKETPAIR
465 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
466 (SCM family
, SCM style
, SCM proto
),
467 "Return a pair of connected (but unnamed) socket ports of the\n"
468 "type specified by @var{family}, @var{style} and @var{proto}.\n"
469 "Many systems support only socket pairs of the @code{AF_UNIX}\n"
470 "family. Zero is likely to be the only meaningful value for\n"
472 #define FUNC_NAME s_scm_socketpair
477 SCM_VALIDATE_INUM (1,family
);
478 SCM_VALIDATE_INUM (2,style
);
479 SCM_VALIDATE_INUM (3,proto
);
481 fam
= SCM_INUM (family
);
483 if (socketpair (fam
, SCM_INUM (style
), SCM_INUM (proto
), fd
) == -1)
486 return scm_cons (SCM_SOCK_FD_TO_PORT (fd
[0]), SCM_SOCK_FD_TO_PORT (fd
[1]));
491 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
492 (SCM sock
, SCM level
, SCM optname
),
493 "Return the value of a particular socket option for the socket\n"
494 "port @var{sock}. @var{level} is an integer code for type of\n"
495 "option being requested, e.g., @code{SOL_SOCKET} for\n"
496 "socket-level options. @var{optname} is an integer code for the\n"
497 "option required and should be specified using one of the\n"
498 "symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n\n"
499 "The returned value is typically an integer but @code{SO_LINGER}\n"
500 "returns a pair of integers.")
501 #define FUNC_NAME s_scm_getsockopt
504 /* size of optval is the largest supported option. */
505 #ifdef HAVE_STRUCT_LINGER
506 char optval
[sizeof (struct linger
)];
507 int optlen
= sizeof (struct linger
);
509 char optval
[sizeof (size_t)];
510 int optlen
= sizeof (size_t);
515 sock
= SCM_COERCE_OUTPORT (sock
);
516 SCM_VALIDATE_OPFPORT (1, sock
);
517 SCM_VALIDATE_INUM_COPY (2, level
, ilevel
);
518 SCM_VALIDATE_INUM_COPY (3, optname
, ioptname
);
520 fd
= SCM_FPORT_FDES (sock
);
521 if (getsockopt (fd
, ilevel
, ioptname
, (void *) optval
, &optlen
) == -1)
524 if (ilevel
== SOL_SOCKET
)
527 if (ioptname
== SO_LINGER
)
529 #ifdef HAVE_STRUCT_LINGER
530 struct linger
*ling
= (struct linger
*) optval
;
532 return scm_cons (scm_long2num (ling
->l_onoff
),
533 scm_long2num (ling
->l_linger
));
535 return scm_cons (scm_long2num (*(int *) optval
),
543 || ioptname
== SO_SNDBUF
546 || ioptname
== SO_RCVBUF
550 return scm_long2num (*(size_t *) optval
);
553 return scm_long2num (*(int *) optval
);
557 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
558 (SCM sock
, SCM level
, SCM optname
, SCM value
),
559 "Set the value of a particular socket option for the socket\n"
560 "port @var{sock}. @var{level} is an integer code for type of option\n"
561 "being set, e.g., @code{SOL_SOCKET} for socket-level options.\n"
562 "@var{optname} is an\n"
563 "integer code for the option to set and should be specified using one of\n"
564 "the symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n"
565 "@var{value} is the value to which the option should be set. For\n"
566 "most options this must be an integer, but for @code{SO_LINGER} it must\n"
568 "The return value is unspecified.")
569 #define FUNC_NAME s_scm_setsockopt
573 /* size of optval is the largest supported option. */
574 #ifdef HAVE_STRUCT_LINGER
575 char optval
[sizeof (struct linger
)];
577 char optval
[sizeof (size_t)];
579 int ilevel
, ioptname
;
581 sock
= SCM_COERCE_OUTPORT (sock
);
583 SCM_VALIDATE_OPFPORT (1, sock
);
584 SCM_VALIDATE_INUM_COPY (2, level
, ilevel
);
585 SCM_VALIDATE_INUM_COPY (3, optname
, ioptname
);
587 fd
= SCM_FPORT_FDES (sock
);
589 if (ilevel
== SOL_SOCKET
)
592 if (ioptname
== SO_LINGER
)
594 #ifdef HAVE_STRUCT_LINGER
598 SCM_ASSERT (SCM_CONSP (value
), value
, SCM_ARG4
, FUNC_NAME
);
599 lv
= SCM_NUM2LONG (4, SCM_CAR (value
));
600 ling
.l_onoff
= (int) lv
;
601 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
.l_onoff
== lv
);
602 lv
= SCM_NUM2LONG (4, SCM_CDR (value
));
603 ling
.l_linger
= (int) lv
;
604 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
.l_linger
== lv
);
605 optlen
= (int) sizeof (struct linger
);
606 memcpy (optval
, (void *) &ling
, optlen
);
611 SCM_ASSERT (SCM_CONSP (value
), value
, SCM_ARG4
, FUNC_NAME
);
612 /* timeout is ignored, but may as well validate it. */
613 lv
= SCM_NUM2LONG (4, SCM_CDR (value
));
615 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
== lv
);
616 lv
= SCM_NUM2LONG (4, SCM_CAR (value
));
618 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
== lv
);
619 optlen
= (int) sizeof (int);
620 (*(int *) optval
) = ling
;
627 || ioptname
== SO_SNDBUF
630 || ioptname
== SO_RCVBUF
634 long lv
= SCM_NUM2LONG (4, value
);
636 optlen
= (int) sizeof (size_t);
637 (*(size_t *) optval
) = (size_t) lv
;
642 /* Most options take an int. */
643 long lv
= SCM_NUM2LONG (4, value
);
646 SCM_ASSERT_RANGE (SCM_ARG4
, value
, val
== lv
);
647 optlen
= (int) sizeof (int);
648 (*(int *) optval
) = val
;
650 if (setsockopt (fd
, ilevel
, ioptname
, (void *) optval
, optlen
) == -1)
652 return SCM_UNSPECIFIED
;
656 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
658 "Sockets can be closed simply by using @code{close-port}. The\n"
659 "@code{shutdown} procedure allows reception or transmission on a\n"
660 "connection to be shut down individually, according to the parameter\n"
664 "Stop receiving data for this socket. If further data arrives, reject it.\n"
666 "Stop trying to transmit data from this socket. Discard any\n"
667 "data waiting to be sent. Stop looking for acknowledgement of\n"
668 "data already sent; don't retransmit it if it is lost.\n"
670 "Stop both reception and transmission.\n"
672 "The return value is unspecified.")
673 #define FUNC_NAME s_scm_shutdown
676 sock
= SCM_COERCE_OUTPORT (sock
);
677 SCM_VALIDATE_OPFPORT (1,sock
);
678 SCM_VALIDATE_INUM (2,how
);
679 SCM_ASSERT_RANGE(2,how
,0 <= SCM_INUM (how
) && 2 >= SCM_INUM (how
));
680 fd
= SCM_FPORT_FDES (sock
);
681 if (shutdown (fd
, SCM_INUM (how
)) == -1)
683 return SCM_UNSPECIFIED
;
687 /* convert fam/address/args into a sockaddr of the appropriate type.
688 args is modified by removing the arguments actually used.
689 which_arg and proc are used when reporting errors:
690 which_arg is the position of address in the original argument list.
691 proc is the name of the original procedure.
692 size returns the size of the structure allocated. */
694 static struct sockaddr
*
695 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
696 const char *proc
, int *size
)
697 #define FUNC_NAME proc
703 struct sockaddr_in
*soka
;
707 SCM_VALIDATE_ULONG_COPY (which_arg
, address
, addr
);
708 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
709 SCM_VALIDATE_INUM_COPY (which_arg
+ 1, SCM_CAR (*args
), port
);
710 *args
= SCM_CDR (*args
);
711 soka
= (struct sockaddr_in
*) malloc (sizeof (struct sockaddr_in
));
713 scm_memory_error (proc
);
714 /* 4.4BSD-style interface includes sin_len member and defines SIN_LEN,
717 soka
->sin_len
= sizeof (struct sockaddr_in
);
719 soka
->sin_family
= AF_INET
;
720 soka
->sin_addr
.s_addr
= htonl (addr
);
721 soka
->sin_port
= htons (port
);
722 *size
= sizeof (struct sockaddr_in
);
723 return (struct sockaddr
*) soka
;
730 struct sockaddr_in6
*soka
;
731 unsigned long flowinfo
= 0;
732 unsigned long scope_id
= 0;
734 VALIDATE_INET6 (which_arg
, address
);
735 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
736 SCM_VALIDATE_INUM_COPY (which_arg
+ 1, SCM_CAR (*args
), port
);
737 *args
= SCM_CDR (*args
);
738 if (SCM_CONSP (*args
))
740 SCM_VALIDATE_ULONG_COPY (which_arg
+ 2, SCM_CAR (*args
), flowinfo
);
741 *args
= SCM_CDR (*args
);
742 if (SCM_CONSP (*args
))
744 SCM_VALIDATE_ULONG_COPY (which_arg
+ 3, SCM_CAR (*args
),
746 *args
= SCM_CDR (*args
);
749 soka
= (struct sockaddr_in6
*) malloc (sizeof (struct sockaddr_in6
));
751 scm_memory_error (proc
);
753 soka
->sin6_len
= sizeof (struct sockaddr_in6
);
755 soka
->sin6_family
= AF_INET6
;
756 ipv6_num_to_net (address
, soka
->sin6_addr
.s6_addr
);
757 soka
->sin6_port
= htons (port
);
758 soka
->sin6_flowinfo
= flowinfo
;
759 #ifdef HAVE_SIN6_SCOPE_ID
760 soka
->sin6_scope_id
= scope_id
;
762 *size
= sizeof (struct sockaddr_in6
);
763 return (struct sockaddr
*) soka
;
766 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
769 struct sockaddr_un
*soka
;
772 SCM_ASSERT (SCM_STRINGP (address
), address
, which_arg
, proc
);
773 /* the static buffer size in sockaddr_un seems to be arbitrary
774 and not necessarily a hard limit. e.g., the glibc manual
775 suggests it may be possible to declare it size 0. let's
776 ignore it. if the O/S doesn't like the size it will cause
777 connect/bind etc., to fail. sun_path is always the last
778 member of the structure. */
779 addr_size
= sizeof (struct sockaddr_un
)
780 + max (0, SCM_STRING_LENGTH (address
) + 1 - (sizeof soka
->sun_path
));
781 soka
= (struct sockaddr_un
*) malloc (addr_size
);
783 scm_memory_error (proc
);
784 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
785 soka
->sun_family
= AF_UNIX
;
786 memcpy (soka
->sun_path
, SCM_STRING_CHARS (address
),
787 SCM_STRING_LENGTH (address
));
788 *size
= SUN_LEN (soka
);
789 return (struct sockaddr
*) soka
;
793 scm_out_of_range (proc
, SCM_MAKINUM (fam
));
798 SCM_DEFINE (scm_connect
, "connect", 3, 0, 1,
799 (SCM sock
, SCM fam
, SCM address
, SCM args
),
800 "Initiate a connection from a socket using a specified address\n"
801 "family to the address\n"
802 "specified by @var{address} and possibly @var{args}.\n"
803 "The format required for @var{address}\n"
804 "and @var{args} depends on the family of the socket.\n\n"
805 "For a socket of family @code{AF_UNIX},\n"
806 "only @var{address} is specified and must be a string with the\n"
807 "filename where the socket is to be created.\n\n"
808 "For a socket of family @code{AF_INET},\n"
809 "@var{address} must be an integer IPv4 host address and\n"
810 "@var{args} must be a single integer port number.\n\n"
811 "For a socket of family @code{AF_INET6},\n"
812 "@var{address} must be an integer IPv6 host address and\n"
813 "@var{args} may be up to three integers:\n"
814 "port [flowinfo] [scope_id],\n"
815 "where flowinfo and scope_id default to zero.\n\n"
816 "The return value is unspecified.")
817 #define FUNC_NAME s_scm_connect
820 struct sockaddr
*soka
;
823 sock
= SCM_COERCE_OUTPORT (sock
);
824 SCM_VALIDATE_OPFPORT (1,sock
);
825 SCM_VALIDATE_INUM (2,fam
);
826 fd
= SCM_FPORT_FDES (sock
);
827 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
829 if (connect (fd
, soka
, size
) == -1)
831 int save_errno
= errno
;
838 return SCM_UNSPECIFIED
;
842 SCM_DEFINE (scm_bind
, "bind", 3, 0, 1,
843 (SCM sock
, SCM fam
, SCM address
, SCM args
),
844 "Assign an address to the socket port @var{sock}.\n"
845 "Generally this only needs to be done for server sockets,\n"
846 "so they know where to look for incoming connections. A socket\n"
847 "without an address will be assigned one automatically when it\n"
848 "starts communicating.\n\n"
849 "The format of @var{address} and @var{args} depends\n"
850 "on the family of the socket.\n\n"
851 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
852 "is specified and must be a string with the filename where\n"
853 "the socket is to be created.\n\n"
854 "For a socket of family @code{AF_INET}, @var{address}\n"
855 "must be an integer IPv4 address and @var{args}\n"
856 "must be a single integer port number.\n\n"
857 "The values of the following variables can also be used for\n"
859 "@defvar INADDR_ANY\n"
860 "Allow connections from any address.\n"
862 "@defvar INADDR_LOOPBACK\n"
863 "The address of the local host using the loopback device.\n"
865 "@defvar INADDR_BROADCAST\n"
866 "The broadcast address on the local network.\n"
868 "@defvar INADDR_NONE\n"
871 "For a socket of family @code{AF_INET6}, @var{address}\n"
872 "must be an integer IPv6 address and @var{args}\n"
873 "may be up to three integers:\n"
874 "port [flowinfo] [scope_id],\n"
875 "where flowinfo and scope_id default to zero.\n\n"
876 "The return value is unspecified.")
877 #define FUNC_NAME s_scm_bind
879 struct sockaddr
*soka
;
883 sock
= SCM_COERCE_OUTPORT (sock
);
884 SCM_VALIDATE_OPFPORT (1, sock
);
885 SCM_VALIDATE_INUM (2, fam
);
886 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
888 fd
= SCM_FPORT_FDES (sock
);
889 if (bind (fd
, soka
, size
) == -1)
891 int save_errno
= errno
;
898 return SCM_UNSPECIFIED
;
902 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
903 (SCM sock
, SCM backlog
),
904 "Enable @var{sock} to accept connection\n"
905 "requests. @var{backlog} is an integer specifying\n"
906 "the maximum length of the queue for pending connections.\n"
907 "If the queue fills, new clients will fail to connect until\n"
908 "the server calls @code{accept} to accept a connection from\n"
910 "The return value is unspecified.")
911 #define FUNC_NAME s_scm_listen
914 sock
= SCM_COERCE_OUTPORT (sock
);
915 SCM_VALIDATE_OPFPORT (1,sock
);
916 SCM_VALIDATE_INUM (2,backlog
);
917 fd
= SCM_FPORT_FDES (sock
);
918 if (listen (fd
, SCM_INUM (backlog
)) == -1)
920 return SCM_UNSPECIFIED
;
924 /* Put the components of a sockaddr into a new SCM vector. */
926 scm_addr_vector (const struct sockaddr
*address
, const char *proc
)
928 short int fam
= address
->sa_family
;
936 const struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
938 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
939 ve
= SCM_VELTS (result
);
940 ve
[0] = scm_ulong2num ((unsigned long) fam
);
941 ve
[1] = scm_ulong2num (ntohl (nad
->sin_addr
.s_addr
));
942 ve
[2] = scm_ulong2num ((unsigned long) ntohs (nad
->sin_port
));
948 const struct sockaddr_in6
*nad
= (struct sockaddr_in6
*) address
;
950 result
= scm_c_make_vector (5, SCM_UNSPECIFIED
);
951 ve
= SCM_VELTS (result
);
952 ve
[0] = scm_ulong2num ((unsigned long) fam
);
953 ve
[1] = ipv6_net_to_num (nad
->sin6_addr
.s6_addr
);
954 ve
[2] = scm_ulong2num ((unsigned long) ntohs (nad
->sin6_port
));
955 ve
[3] = scm_ulong2num ((unsigned long) nad
->sin6_flowinfo
);
956 #ifdef HAVE_SIN6_SCOPE_ID
957 ve
[4] = scm_ulong2num ((unsigned long) nad
->sin6_scope_id
);
964 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
967 const struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
969 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
970 ve
= SCM_VELTS (result
);
971 ve
[0] = scm_ulong2num ((unsigned long) fam
);
972 ve
[1] = scm_mem2string (nad
->sun_path
, strlen (nad
->sun_path
));
977 scm_misc_error (proc
, "Unrecognised address family: ~A",
978 scm_list_1 (SCM_MAKINUM (fam
)));
983 /* calculate the size of a buffer large enough to hold any supported
984 sockaddr type. if the buffer isn't large enough, certain system
985 calls will return a truncated address. */
987 #if defined (HAVE_UNIX_DOMAIN_SOCKETS)
988 #define MAX_SIZE_UN sizeof (struct sockaddr_un)
990 #define MAX_SIZE_UN 0
993 #if defined (HAVE_IPV6)
994 #define MAX_SIZE_IN6 sizeof (struct sockaddr_in6)
996 #define MAX_SIZE_IN6 0
999 #define MAX_ADDR_SIZE max (max (sizeof (struct sockaddr_in), MAX_SIZE_IN6),\
1002 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
1004 "Accept a connection on a bound, listening socket.\n"
1006 "are no pending connections in the queue, wait until\n"
1007 "one is available unless the non-blocking option has been\n"
1008 "set on the socket.\n\n"
1009 "The return value is a\n"
1010 "pair in which the @emph{car} is a new socket port for the\n"
1012 "the @emph{cdr} is an object with address information about the\n"
1013 "client which initiated the connection.\n\n"
1014 "@var{sock} does not become part of the\n"
1015 "connection and will continue to accept new requests.")
1016 #define FUNC_NAME s_scm_accept
1022 int addr_size
= MAX_ADDR_SIZE
;
1023 char max_addr
[MAX_ADDR_SIZE
];
1024 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1026 sock
= SCM_COERCE_OUTPORT (sock
);
1027 SCM_VALIDATE_OPFPORT (1, sock
);
1028 fd
= SCM_FPORT_FDES (sock
);
1029 newfd
= accept (fd
, addr
, &addr_size
);
1032 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
1033 address
= scm_addr_vector (addr
, FUNC_NAME
);
1034 return scm_cons (newsock
, address
);
1038 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
1040 "Return the address of @var{sock}, in the same form as the\n"
1041 "object returned by @code{accept}. On many systems the address\n"
1042 "of a socket in the @code{AF_FILE} namespace cannot be read.")
1043 #define FUNC_NAME s_scm_getsockname
1046 int addr_size
= MAX_ADDR_SIZE
;
1047 char max_addr
[MAX_ADDR_SIZE
];
1048 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1050 sock
= SCM_COERCE_OUTPORT (sock
);
1051 SCM_VALIDATE_OPFPORT (1,sock
);
1052 fd
= SCM_FPORT_FDES (sock
);
1053 if (getsockname (fd
, addr
, &addr_size
) == -1)
1055 return scm_addr_vector (addr
, FUNC_NAME
);
1059 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
1061 "Return the address that @var{sock}\n"
1062 "is connected to, in the same form as the object returned by\n"
1063 "@code{accept}. On many systems the address of a socket in the\n"
1064 "@code{AF_FILE} namespace cannot be read.")
1065 #define FUNC_NAME s_scm_getpeername
1068 int addr_size
= MAX_ADDR_SIZE
;
1069 char max_addr
[MAX_ADDR_SIZE
];
1070 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1072 sock
= SCM_COERCE_OUTPORT (sock
);
1073 SCM_VALIDATE_OPFPORT (1,sock
);
1074 fd
= SCM_FPORT_FDES (sock
);
1075 if (getpeername (fd
, addr
, &addr_size
) == -1)
1077 return scm_addr_vector (addr
, FUNC_NAME
);
1081 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
1082 (SCM sock
, SCM buf
, SCM flags
),
1083 "Receive data from a socket port.\n"
1084 "@var{sock} must already\n"
1085 "be bound to the address from which data is to be received.\n"
1086 "@var{buf} is a string into which\n"
1087 "the data will be written. The size of @var{buf} limits\n"
1089 "data which can be received: in the case of packet\n"
1090 "protocols, if a packet larger than this limit is encountered\n"
1092 "will be irrevocably lost.\n\n"
1093 "The optional @var{flags} argument is a value or\n"
1094 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1095 "The value returned is the number of bytes read from the\n"
1097 "Note that the data is read directly from the socket file\n"
1099 "any unread buffered port data is ignored.")
1100 #define FUNC_NAME s_scm_recv
1106 SCM_VALIDATE_OPFPORT (1,sock
);
1107 SCM_VALIDATE_STRING (2,buf
);
1108 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
1109 fd
= SCM_FPORT_FDES (sock
);
1111 SCM_SYSCALL (rv
= recv (fd
, SCM_STRING_CHARS (buf
), SCM_STRING_LENGTH (buf
), flg
));
1115 return SCM_MAKINUM (rv
);
1119 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
1120 (SCM sock
, SCM message
, SCM flags
),
1121 "Transmit the string @var{message} on a socket port @var{sock}.\n"
1122 "@var{sock} must already be bound to a destination address. The\n"
1123 "value returned is the number of bytes transmitted --\n"
1124 "it's possible for\n"
1125 "this to be less than the length of @var{message}\n"
1126 "if the socket is\n"
1127 "set to be non-blocking. The optional @var{flags} argument\n"
1129 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1130 "Note that the data is written directly to the socket\n"
1131 "file descriptor:\n"
1132 "any unflushed buffered port data is ignored.")
1133 #define FUNC_NAME s_scm_send
1139 sock
= SCM_COERCE_OUTPORT (sock
);
1140 SCM_VALIDATE_OPFPORT (1,sock
);
1141 SCM_VALIDATE_STRING (2, message
);
1142 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
1143 fd
= SCM_FPORT_FDES (sock
);
1145 SCM_SYSCALL (rv
= send (fd
, SCM_STRING_CHARS (message
), SCM_STRING_LENGTH (message
), flg
));
1148 return SCM_MAKINUM (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
);
1188 SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, str
, buf
, 4, start
, offset
,
1190 if (SCM_UNBNDP (flags
))
1193 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
1195 /* recvfrom will not necessarily return an address. usually nothing
1196 is returned for stream sockets. */
1197 addr
->sa_family
= AF_UNSPEC
;
1198 SCM_SYSCALL (rv
= recvfrom (fd
, buf
+ offset
,
1203 if (addr
->sa_family
!= AF_UNSPEC
)
1204 address
= scm_addr_vector (addr
, FUNC_NAME
);
1206 address
= SCM_BOOL_F
;
1208 return scm_cons (SCM_MAKINUM (rv
), address
);
1212 SCM_DEFINE (scm_sendto
, "sendto", 4, 0, 1,
1213 (SCM sock
, SCM message
, SCM fam
, SCM address
, SCM args_and_flags
),
1214 "Transmit the string @var{message} on the socket port\n"
1216 "destination address is specified using the @var{fam},\n"
1217 "@var{address} and\n"
1218 "@var{args_and_flags} arguments, in a similar way to the\n"
1219 "@code{connect} procedure. @var{args_and_flags} contains\n"
1220 "the usual connection arguments optionally followed by\n"
1221 "a flags argument, which is a value or\n"
1222 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1223 "The value returned is the number of bytes transmitted --\n"
1224 "it's possible for\n"
1225 "this to be less than the length of @var{message} if the\n"
1227 "set to be non-blocking.\n"
1228 "Note that the data is written directly to the socket\n"
1229 "file descriptor:\n"
1230 "any unflushed buffered port data is ignored.")
1231 #define FUNC_NAME s_scm_sendto
1236 struct sockaddr
*soka
;
1239 sock
= SCM_COERCE_OUTPORT (sock
);
1240 SCM_VALIDATE_FPORT (1,sock
);
1241 SCM_VALIDATE_STRING (2, message
);
1242 SCM_VALIDATE_INUM (3,fam
);
1243 fd
= SCM_FPORT_FDES (sock
);
1244 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args_and_flags
, 4,
1246 if (SCM_NULLP (args_and_flags
))
1250 SCM_VALIDATE_CONS (5,args_and_flags
);
1251 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
1253 SCM_SYSCALL (rv
= sendto (fd
, SCM_STRING_CHARS (message
),
1254 SCM_STRING_LENGTH (message
),
1258 int save_errno
= errno
;
1264 return SCM_MAKINUM (rv
);
1273 /* protocol families. */
1275 scm_c_define ("AF_UNSPEC", SCM_MAKINUM (AF_UNSPEC
));
1278 scm_c_define ("AF_UNIX", SCM_MAKINUM (AF_UNIX
));
1281 scm_c_define ("AF_INET", SCM_MAKINUM (AF_INET
));
1284 scm_c_define ("AF_INET6", SCM_MAKINUM (AF_INET6
));
1288 scm_c_define ("PF_UNSPEC", SCM_MAKINUM (PF_UNSPEC
));
1291 scm_c_define ("PF_UNIX", SCM_MAKINUM (PF_UNIX
));
1294 scm_c_define ("PF_INET", SCM_MAKINUM (PF_INET
));
1297 scm_c_define ("PF_INET6", SCM_MAKINUM (PF_INET6
));
1300 /* standard addresses. */
1302 scm_c_define ("INADDR_ANY", scm_ulong2num (INADDR_ANY
));
1304 #ifdef INADDR_BROADCAST
1305 scm_c_define ("INADDR_BROADCAST", scm_ulong2num (INADDR_BROADCAST
));
1308 scm_c_define ("INADDR_NONE", scm_ulong2num (INADDR_NONE
));
1310 #ifdef INADDR_LOOPBACK
1311 scm_c_define ("INADDR_LOOPBACK", scm_ulong2num (INADDR_LOOPBACK
));
1316 scm_c_define ("SOCK_STREAM", SCM_MAKINUM (SOCK_STREAM
));
1319 scm_c_define ("SOCK_DGRAM", SCM_MAKINUM (SOCK_DGRAM
));
1322 scm_c_define ("SOCK_RAW", SCM_MAKINUM (SOCK_RAW
));
1325 /* setsockopt level. */
1327 scm_c_define ("SOL_SOCKET", SCM_MAKINUM (SOL_SOCKET
));
1330 scm_c_define ("SOL_IP", SCM_MAKINUM (SOL_IP
));
1333 scm_c_define ("SOL_TCP", SCM_MAKINUM (SOL_TCP
));
1336 scm_c_define ("SOL_UDP", SCM_MAKINUM (SOL_UDP
));
1339 /* setsockopt names. */
1341 scm_c_define ("SO_DEBUG", SCM_MAKINUM (SO_DEBUG
));
1344 scm_c_define ("SO_REUSEADDR", SCM_MAKINUM (SO_REUSEADDR
));
1347 scm_c_define ("SO_STYLE", SCM_MAKINUM (SO_STYLE
));
1350 scm_c_define ("SO_TYPE", SCM_MAKINUM (SO_TYPE
));
1353 scm_c_define ("SO_ERROR", SCM_MAKINUM (SO_ERROR
));
1356 scm_c_define ("SO_DONTROUTE", SCM_MAKINUM (SO_DONTROUTE
));
1359 scm_c_define ("SO_BROADCAST", SCM_MAKINUM (SO_BROADCAST
));
1362 scm_c_define ("SO_SNDBUF", SCM_MAKINUM (SO_SNDBUF
));
1365 scm_c_define ("SO_RCVBUF", SCM_MAKINUM (SO_RCVBUF
));
1368 scm_c_define ("SO_KEEPALIVE", SCM_MAKINUM (SO_KEEPALIVE
));
1371 scm_c_define ("SO_OOBINLINE", SCM_MAKINUM (SO_OOBINLINE
));
1374 scm_c_define ("SO_NO_CHECK", SCM_MAKINUM (SO_NO_CHECK
));
1377 scm_c_define ("SO_PRIORITY", SCM_MAKINUM (SO_PRIORITY
));
1380 scm_c_define ("SO_LINGER", SCM_MAKINUM (SO_LINGER
));
1383 /* recv/send options. */
1385 scm_c_define ("MSG_OOB", SCM_MAKINUM (MSG_OOB
));
1388 scm_c_define ("MSG_PEEK", SCM_MAKINUM (MSG_PEEK
));
1390 #ifdef MSG_DONTROUTE
1391 scm_c_define ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE
));
1395 scm_i_init_socket_Win32 ();
1398 scm_add_feature ("socket");
1400 #include "libguile/socket.x"