1 /* Copyright (C) 1996,1997,1998,2000,2001, 2002 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 #ifdef HAVE_WINSOCK2_H
74 #include <sys/socket.h>
75 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
78 #include <netinet/in.h>
80 #include <arpa/inet.h>
83 #if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
84 #define SUN_LEN(ptr) ((size_t) (((struct sockaddr_un *) 0)->sun_path) \
85 + strlen ((ptr)->sun_path))
88 #if !defined (HAVE_UINT32_T)
90 typedef unsigned int uint32_t;
91 #elif SIZEOF_LONG == 4
92 typedef unsigned long uint32_t;
94 #error can not define uint32_t
98 /* we are not currently using socklen_t. it's not defined on all systems,
99 so would need to be checked by configure. in the meantime, plain
100 int is the best alternative. */
104 SCM_DEFINE (scm_htons
, "htons", 1, 0, 0,
106 "Convert a 16 bit quantity from host to network byte ordering.\n"
107 "@var{value} is packed into 2 bytes, which are then converted\n"
108 "and returned as a new integer.")
109 #define FUNC_NAME s_scm_htons
113 SCM_VALIDATE_INUM_COPY (1, value
, c_in
);
114 if (c_in
!= SCM_INUM (value
))
115 SCM_OUT_OF_RANGE (1, value
);
117 return SCM_MAKINUM (htons (c_in
));
121 SCM_DEFINE (scm_ntohs
, "ntohs", 1, 0, 0,
123 "Convert a 16 bit quantity from network to host byte ordering.\n"
124 "@var{value} is packed into 2 bytes, which are then converted\n"
125 "and returned as a new integer.")
126 #define FUNC_NAME s_scm_ntohs
130 SCM_VALIDATE_INUM_COPY (1, value
, c_in
);
131 if (c_in
!= SCM_INUM (value
))
132 SCM_OUT_OF_RANGE (1, value
);
134 return SCM_MAKINUM (ntohs (c_in
));
138 SCM_DEFINE (scm_htonl
, "htonl", 1, 0, 0,
140 "Convert a 32 bit quantity from host to network byte ordering.\n"
141 "@var{value} is packed into 4 bytes, which are then converted\n"
142 "and returned as a new integer.")
143 #define FUNC_NAME s_scm_htonl
145 uint32_t c_in
= SCM_NUM2ULONG (1, value
);
147 return scm_ulong2num (htonl (c_in
));
151 SCM_DEFINE (scm_ntohl
, "ntohl", 1, 0, 0,
153 "Convert a 32 bit quantity from network to host byte ordering.\n"
154 "@var{value} is packed into 4 bytes, which are then converted\n"
155 "and returned as a new integer.")
156 #define FUNC_NAME s_scm_ntohl
158 uint32_t c_in
= SCM_NUM2ULONG (1, value
);
160 return scm_ulong2num (ntohl (c_in
));
164 #ifndef HAVE_INET_ATON
165 /* for our definition in inet_aton.c, not usually needed. */
166 extern int inet_aton ();
169 SCM_DEFINE (scm_inet_aton
, "inet-aton", 1, 0, 0,
171 "Convert an IPv4 Internet address from printable string\n"
172 "(dotted decimal notation) to an integer. E.g.,\n\n"
174 "(inet-aton \"127.0.0.1\") @result{} 2130706433\n"
176 #define FUNC_NAME s_scm_inet_aton
180 SCM_VALIDATE_STRING (1, address
);
181 if (inet_aton (SCM_STRING_CHARS (address
), &soka
) == 0)
182 SCM_MISC_ERROR ("bad address", SCM_EOL
);
183 return scm_ulong2num (ntohl (soka
.s_addr
));
188 SCM_DEFINE (scm_inet_ntoa
, "inet-ntoa", 1, 0, 0,
190 "Convert an IPv4 Internet address to a printable\n"
191 "(dotted decimal notation) string. E.g.,\n\n"
193 "(inet-ntoa 2130706433) @result{} \"127.0.0.1\"\n"
195 #define FUNC_NAME s_scm_inet_ntoa
200 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, inetid
));
201 s
= inet_ntoa (addr
);
202 answer
= scm_mem2string (s
, strlen (s
));
207 #ifdef HAVE_INET_NETOF
208 SCM_DEFINE (scm_inet_netof
, "inet-netof", 1, 0, 0,
210 "Return the network number part of the given IPv4\n"
211 "Internet address. E.g.,\n\n"
213 "(inet-netof 2130706433) @result{} 127\n"
215 #define FUNC_NAME s_scm_inet_netof
218 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
219 return scm_ulong2num ((unsigned long) inet_netof (addr
));
224 #ifdef HAVE_INET_LNAOF
225 SCM_DEFINE (scm_lnaof
, "inet-lnaof", 1, 0, 0,
227 "Return the local-address-with-network part of the given\n"
228 "IPv4 Internet address, using the obsolete class A/B/C system.\n"
231 "(inet-lnaof 2130706433) @result{} 1\n"
233 #define FUNC_NAME s_scm_lnaof
236 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
237 return scm_ulong2num ((unsigned long) inet_lnaof (addr
));
242 #ifdef HAVE_INET_MAKEADDR
243 SCM_DEFINE (scm_inet_makeaddr
, "inet-makeaddr", 2, 0, 0,
245 "Make an IPv4 Internet address by combining the network number\n"
246 "@var{net} with the local-address-within-network number\n"
247 "@var{lna}. E.g.,\n\n"
249 "(inet-makeaddr 127 1) @result{} 2130706433\n"
251 #define FUNC_NAME s_scm_inet_makeaddr
254 unsigned long netnum
;
255 unsigned long lnanum
;
257 netnum
= SCM_NUM2ULONG (1, net
);
258 lnanum
= SCM_NUM2ULONG (2, lna
);
259 addr
= inet_makeaddr (netnum
, lnanum
);
260 return scm_ulong2num (ntohl (addr
.s_addr
));
267 /* flip a 128 bit IPv6 address between host and network order. */
268 #ifdef WORDS_BIGENDIAN
269 #define FLIP_NET_HOST_128(addr)
271 #define FLIP_NET_HOST_128(addr)\
275 for (i = 0; i < 8; i++)\
279 (addr)[i] = (addr)[15 - i];\
285 /* convert a 128 bit IPv6 address in network order to a host ordered
287 static SCM
ipv6_net_to_num (const char *src
)
289 int big_digits
= 128 / SCM_BITSPERDIG
;
290 const int bytes_per_dig
= SCM_BITSPERDIG
/ 8;
295 memcpy (addr
, src
, 16);
296 /* get rid of leading zeros. */
297 while (big_digits
> 0)
301 memcpy (&test
, ptr
, bytes_per_dig
);
304 ptr
+= bytes_per_dig
;
307 FLIP_NET_HOST_128 (addr
);
308 if (big_digits
* bytes_per_dig
<= sizeof (unsigned long))
310 /* this is just so that we use INUM where possible. */
311 unsigned long l_addr
;
313 memcpy (&l_addr
, addr
, sizeof (unsigned long));
314 result
= scm_ulong2num (l_addr
);
318 result
= scm_i_mkbig (big_digits
, 0);
319 memcpy (SCM_BDIGITS (result
), addr
, big_digits
* bytes_per_dig
);
324 /* convert a host ordered SCM integer to a 128 bit IPv6 address in
326 static void ipv6_num_to_net (SCM src
, char *dst
)
330 uint32_t addr
= htonl (SCM_INUM (src
));
333 memcpy (dst
+ 12, &addr
, 4);
338 memcpy (dst
, SCM_BDIGITS (src
),
339 SCM_NUMDIGS (src
) * (SCM_BITSPERDIG
/ 8));
340 FLIP_NET_HOST_128 (dst
);
344 /* check that an SCM variable contains an IPv6 integer address. */
345 #define VALIDATE_INET6(which_arg, address)\
346 if (SCM_INUMP (address))\
347 SCM_ASSERT_RANGE (which_arg, address, SCM_INUM (address) >= 0);\
350 SCM_VALIDATE_BIGINT (which_arg, address);\
351 SCM_ASSERT_RANGE (which_arg, address,\
352 !SCM_BIGSIGN (address)\
354 * SCM_NUMDIGS (address) <= 128));\
357 #ifdef HAVE_INET_PTON
358 SCM_DEFINE (scm_inet_pton
, "inet-pton", 2, 0, 0,
359 (SCM family
, SCM address
),
360 "Convert a string containing a printable network address to\n"
361 "an integer address. Note that unlike the C version of this\n"
363 "the result is an integer with normal host byte ordering.\n"
364 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
366 "(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
367 "(inet-pton AF_INET6 \"::1\") @result{} 1\n"
369 #define FUNC_NAME s_scm_inet_pton
376 SCM_VALIDATE_INUM_COPY (1, family
, af
);
377 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
378 SCM_VALIDATE_STRING_COPY (2, address
, src
);
379 rv
= inet_pton (af
, src
, dst
);
383 SCM_MISC_ERROR ("Bad address", SCM_EOL
);
385 return scm_ulong2num (ntohl (*(uint32_t *) dst
));
387 return ipv6_net_to_num ((char *) dst
);
392 #ifdef HAVE_INET_NTOP
393 SCM_DEFINE (scm_inet_ntop
, "inet-ntop", 2, 0, 0,
394 (SCM family
, SCM address
),
395 "Convert a network address into a printable string.\n"
396 "Note that unlike the C version of this function,\n"
397 "the input is an integer with normal host byte ordering.\n"
398 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
400 "(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
401 "(inet-ntop AF_INET6 (- (expt 2 128) 1)) @result{}\n"
402 "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\n"
404 #define FUNC_NAME s_scm_inet_ntop
407 #ifdef INET6_ADDRSTRLEN
408 char dst
[INET6_ADDRSTRLEN
];
414 SCM_VALIDATE_INUM_COPY (1, family
, af
);
415 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
417 *(uint32_t *) addr6
= htonl (SCM_NUM2ULONG (2, address
));
420 VALIDATE_INET6 (2, address
);
421 ipv6_num_to_net (address
, addr6
);
423 if (inet_ntop (af
, &addr6
, dst
, sizeof dst
) == NULL
)
425 return scm_makfrom0str (dst
);
430 #endif /* HAVE_IPV6 */
432 SCM_SYMBOL (sym_socket
, "socket");
434 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
436 SCM_DEFINE (scm_socket
, "socket", 3, 0, 0,
437 (SCM family
, SCM style
, SCM proto
),
438 "Return a new socket port of the type specified by @var{family},\n"
439 "@var{style} and @var{proto}. All three parameters are\n"
440 "integers. Supported values for @var{family} are\n"
441 "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
442 "Typical values for @var{style} are @code{SOCK_STREAM},\n"
443 "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
444 "@var{proto} can be obtained from a protocol name using\n"
445 "@code{getprotobyname}. A value of zero specifies the default\n"
446 "protocol, which is usually right.\n\n"
447 "A single socket port cannot by used for communication until it\n"
448 "has been connected to another socket.")
449 #define FUNC_NAME s_scm_socket
453 SCM_VALIDATE_INUM (1, family
);
454 SCM_VALIDATE_INUM (2, style
);
455 SCM_VALIDATE_INUM (3, proto
);
456 fd
= socket (SCM_INUM (family
), SCM_INUM (style
), SCM_INUM (proto
));
459 return SCM_SOCK_FD_TO_PORT (fd
);
463 #ifdef HAVE_SOCKETPAIR
464 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
465 (SCM family
, SCM style
, SCM proto
),
466 "Return a pair of connected (but unnamed) socket ports of the\n"
467 "type specified by @var{family}, @var{style} and @var{proto}.\n"
468 "Many systems support only socket pairs of the @code{AF_UNIX}\n"
469 "family. Zero is likely to be the only meaningful value for\n"
471 #define FUNC_NAME s_scm_socketpair
476 SCM_VALIDATE_INUM (1, family
);
477 SCM_VALIDATE_INUM (2, style
);
478 SCM_VALIDATE_INUM (3, proto
);
480 fam
= SCM_INUM (family
);
482 if (socketpair (fam
, SCM_INUM (style
), SCM_INUM (proto
), fd
) == -1)
485 return scm_cons (SCM_SOCK_FD_TO_PORT (fd
[0]), SCM_SOCK_FD_TO_PORT (fd
[1]));
490 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
491 (SCM sock
, SCM level
, SCM optname
),
492 "Return the value of a particular socket option for the socket\n"
493 "port @var{sock}. @var{level} is an integer code for type of\n"
494 "option being requested, e.g., @code{SOL_SOCKET} for\n"
495 "socket-level options. @var{optname} is an integer code for the\n"
496 "option required and should be specified using one of the\n"
497 "symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n\n"
498 "The returned value is typically an integer but @code{SO_LINGER}\n"
499 "returns a pair of integers.")
500 #define FUNC_NAME s_scm_getsockopt
503 /* size of optval is the largest supported option. */
504 #ifdef HAVE_STRUCT_LINGER
505 char optval
[sizeof (struct linger
)];
506 int optlen
= sizeof (struct linger
);
508 char optval
[sizeof (size_t)];
509 int optlen
= sizeof (size_t);
514 sock
= SCM_COERCE_OUTPORT (sock
);
515 SCM_VALIDATE_OPFPORT (1, sock
);
516 SCM_VALIDATE_INUM_COPY (2, level
, ilevel
);
517 SCM_VALIDATE_INUM_COPY (3, optname
, ioptname
);
519 fd
= SCM_FPORT_FDES (sock
);
520 if (getsockopt (fd
, ilevel
, ioptname
, (void *) optval
, &optlen
) == -1)
523 if (ilevel
== SOL_SOCKET
)
526 if (ioptname
== SO_LINGER
)
528 #ifdef HAVE_STRUCT_LINGER
529 struct linger
*ling
= (struct linger
*) optval
;
531 return scm_cons (scm_long2num (ling
->l_onoff
),
532 scm_long2num (ling
->l_linger
));
534 return scm_cons (scm_long2num (*(int *) optval
),
542 || ioptname
== SO_SNDBUF
545 || ioptname
== SO_RCVBUF
549 return scm_long2num (*(size_t *) optval
);
552 return scm_long2num (*(int *) optval
);
556 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
557 (SCM sock
, SCM level
, SCM optname
, SCM value
),
558 "Set the value of a particular socket option for the socket\n"
559 "port @var{sock}. @var{level} is an integer code for type of option\n"
560 "being set, e.g., @code{SOL_SOCKET} for socket-level options.\n"
561 "@var{optname} is an\n"
562 "integer code for the option to set and should be specified using one of\n"
563 "the symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n"
564 "@var{value} is the value to which the option should be set. For\n"
565 "most options this must be an integer, but for @code{SO_LINGER} it must\n"
567 "The return value is unspecified.")
568 #define FUNC_NAME s_scm_setsockopt
572 /* size of optval is the largest supported option. */
573 #ifdef HAVE_STRUCT_LINGER
574 char optval
[sizeof (struct linger
)];
576 char optval
[sizeof (size_t)];
578 int ilevel
, ioptname
;
580 sock
= SCM_COERCE_OUTPORT (sock
);
582 SCM_VALIDATE_OPFPORT (1, sock
);
583 SCM_VALIDATE_INUM_COPY (2, level
, ilevel
);
584 SCM_VALIDATE_INUM_COPY (3, optname
, ioptname
);
586 fd
= SCM_FPORT_FDES (sock
);
588 if (ilevel
== SOL_SOCKET
)
591 if (ioptname
== SO_LINGER
)
593 #ifdef HAVE_STRUCT_LINGER
597 SCM_ASSERT (SCM_CONSP (value
), value
, SCM_ARG4
, FUNC_NAME
);
598 lv
= SCM_NUM2LONG (4, SCM_CAR (value
));
599 ling
.l_onoff
= (int) lv
;
600 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
.l_onoff
== lv
);
601 lv
= SCM_NUM2LONG (4, SCM_CDR (value
));
602 ling
.l_linger
= (int) lv
;
603 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
.l_linger
== lv
);
604 optlen
= (int) sizeof (struct linger
);
605 memcpy (optval
, (void *) &ling
, optlen
);
610 SCM_ASSERT (SCM_CONSP (value
), value
, SCM_ARG4
, FUNC_NAME
);
611 /* timeout is ignored, but may as well validate it. */
612 lv
= SCM_NUM2LONG (4, SCM_CDR (value
));
614 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
== lv
);
615 lv
= SCM_NUM2LONG (4, SCM_CAR (value
));
617 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
== lv
);
618 optlen
= (int) sizeof (int);
619 (*(int *) optval
) = ling
;
626 || ioptname
== SO_SNDBUF
629 || ioptname
== SO_RCVBUF
633 long lv
= SCM_NUM2LONG (4, value
);
635 optlen
= (int) sizeof (size_t);
636 (*(size_t *) optval
) = (size_t) lv
;
641 /* Most options take an int. */
642 long lv
= SCM_NUM2LONG (4, value
);
645 SCM_ASSERT_RANGE (SCM_ARG4
, value
, val
== lv
);
646 optlen
= (int) sizeof (int);
647 (*(int *) optval
) = val
;
649 if (setsockopt (fd
, ilevel
, ioptname
, (void *) optval
, optlen
) == -1)
651 return SCM_UNSPECIFIED
;
655 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
657 "Sockets can be closed simply by using @code{close-port}. The\n"
658 "@code{shutdown} procedure allows reception or transmission on a\n"
659 "connection to be shut down individually, according to the parameter\n"
663 "Stop receiving data for this socket. If further data arrives, reject it.\n"
665 "Stop trying to transmit data from this socket. Discard any\n"
666 "data waiting to be sent. Stop looking for acknowledgement of\n"
667 "data already sent; don't retransmit it if it is lost.\n"
669 "Stop both reception and transmission.\n"
671 "The return value is unspecified.")
672 #define FUNC_NAME s_scm_shutdown
675 sock
= SCM_COERCE_OUTPORT (sock
);
676 SCM_VALIDATE_OPFPORT (1, sock
);
677 SCM_VALIDATE_INUM (2, how
);
678 SCM_ASSERT_RANGE(2, how
,0 <= SCM_INUM (how
) && 2 >= SCM_INUM (how
));
679 fd
= SCM_FPORT_FDES (sock
);
680 if (shutdown (fd
, SCM_INUM (how
)) == -1)
682 return SCM_UNSPECIFIED
;
686 /* convert fam/address/args into a sockaddr of the appropriate type.
687 args is modified by removing the arguments actually used.
688 which_arg and proc are used when reporting errors:
689 which_arg is the position of address in the original argument list.
690 proc is the name of the original procedure.
691 size returns the size of the structure allocated. */
693 static struct sockaddr
*
694 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
695 const char *proc
, int *size
)
696 #define FUNC_NAME proc
702 struct sockaddr_in
*soka
;
706 SCM_VALIDATE_ULONG_COPY (which_arg
, address
, addr
);
707 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
708 SCM_VALIDATE_INUM_COPY (which_arg
+ 1, SCM_CAR (*args
), port
);
709 *args
= SCM_CDR (*args
);
710 soka
= (struct sockaddr_in
*) scm_malloc (sizeof (struct sockaddr_in
));
712 scm_memory_error (proc
);
713 /* 4.4BSD-style interface includes sin_len member and defines SIN_LEN,
716 soka
->sin_len
= sizeof (struct sockaddr_in
);
718 soka
->sin_family
= AF_INET
;
719 soka
->sin_addr
.s_addr
= htonl (addr
);
720 soka
->sin_port
= htons (port
);
721 *size
= sizeof (struct sockaddr_in
);
722 return (struct sockaddr
*) soka
;
729 struct sockaddr_in6
*soka
;
730 unsigned long flowinfo
= 0;
731 unsigned long scope_id
= 0;
733 VALIDATE_INET6 (which_arg
, address
);
734 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
735 SCM_VALIDATE_INUM_COPY (which_arg
+ 1, SCM_CAR (*args
), port
);
736 *args
= SCM_CDR (*args
);
737 if (SCM_CONSP (*args
))
739 SCM_VALIDATE_ULONG_COPY (which_arg
+ 2, SCM_CAR (*args
), flowinfo
);
740 *args
= SCM_CDR (*args
);
741 if (SCM_CONSP (*args
))
743 SCM_VALIDATE_ULONG_COPY (which_arg
+ 3, SCM_CAR (*args
),
745 *args
= SCM_CDR (*args
);
748 soka
= (struct sockaddr_in6
*) scm_malloc (sizeof (struct sockaddr_in6
));
750 scm_memory_error (proc
);
752 soka
->sin6_len
= sizeof (struct sockaddr_in6
);
754 soka
->sin6_family
= AF_INET6
;
755 ipv6_num_to_net (address
, soka
->sin6_addr
.s6_addr
);
756 soka
->sin6_port
= htons (port
);
757 soka
->sin6_flowinfo
= flowinfo
;
758 #ifdef HAVE_SIN6_SCOPE_ID
759 soka
->sin6_scope_id
= scope_id
;
761 *size
= sizeof (struct sockaddr_in6
);
762 return (struct sockaddr
*) soka
;
765 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
768 struct sockaddr_un
*soka
;
771 SCM_ASSERT (SCM_STRINGP (address
), address
, which_arg
, proc
);
772 /* the static buffer size in sockaddr_un seems to be arbitrary
773 and not necessarily a hard limit. e.g., the glibc manual
774 suggests it may be possible to declare it size 0. let's
775 ignore it. if the O/S doesn't like the size it will cause
776 connect/bind etc., to fail. sun_path is always the last
777 member of the structure. */
778 addr_size
= sizeof (struct sockaddr_un
)
779 + max (0, SCM_STRING_LENGTH (address
) + 1 - (sizeof soka
->sun_path
));
780 soka
= (struct sockaddr_un
*) scm_malloc (addr_size
);
782 scm_memory_error (proc
);
783 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
784 soka
->sun_family
= AF_UNIX
;
785 memcpy (soka
->sun_path
, SCM_STRING_CHARS (address
),
786 SCM_STRING_LENGTH (address
));
787 *size
= SUN_LEN (soka
);
788 return (struct sockaddr
*) soka
;
792 scm_out_of_range (proc
, SCM_MAKINUM (fam
));
797 SCM_DEFINE (scm_connect
, "connect", 3, 0, 1,
798 (SCM sock
, SCM fam
, SCM address
, SCM args
),
799 "Initiate a connection from a socket using a specified address\n"
800 "family to the address\n"
801 "specified by @var{address} and possibly @var{args}.\n"
802 "The format required for @var{address}\n"
803 "and @var{args} depends on the family of the socket.\n\n"
804 "For a socket of family @code{AF_UNIX},\n"
805 "only @var{address} is specified and must be a string with the\n"
806 "filename where the socket is to be created.\n\n"
807 "For a socket of family @code{AF_INET},\n"
808 "@var{address} must be an integer IPv4 host address and\n"
809 "@var{args} must be a single integer port number.\n\n"
810 "For a socket of family @code{AF_INET6},\n"
811 "@var{address} must be an integer IPv6 host address and\n"
812 "@var{args} may be up to three integers:\n"
813 "port [flowinfo] [scope_id],\n"
814 "where flowinfo and scope_id default to zero.\n\n"
815 "The return value is unspecified.")
816 #define FUNC_NAME s_scm_connect
819 struct sockaddr
*soka
;
822 sock
= SCM_COERCE_OUTPORT (sock
);
823 SCM_VALIDATE_OPFPORT (1, sock
);
824 SCM_VALIDATE_INUM (2, fam
);
825 fd
= SCM_FPORT_FDES (sock
);
826 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
828 if (connect (fd
, soka
, size
) == -1)
830 int save_errno
= errno
;
837 return SCM_UNSPECIFIED
;
841 SCM_DEFINE (scm_bind
, "bind", 3, 0, 1,
842 (SCM sock
, SCM fam
, SCM address
, SCM args
),
843 "Assign an address to the socket port @var{sock}.\n"
844 "Generally this only needs to be done for server sockets,\n"
845 "so they know where to look for incoming connections. A socket\n"
846 "without an address will be assigned one automatically when it\n"
847 "starts communicating.\n\n"
848 "The format of @var{address} and @var{args} depends\n"
849 "on the family of the socket.\n\n"
850 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
851 "is specified and must be a string with the filename where\n"
852 "the socket is to be created.\n\n"
853 "For a socket of family @code{AF_INET}, @var{address}\n"
854 "must be an integer IPv4 address and @var{args}\n"
855 "must be a single integer port number.\n\n"
856 "The values of the following variables can also be used for\n"
858 "@defvar INADDR_ANY\n"
859 "Allow connections from any address.\n"
861 "@defvar INADDR_LOOPBACK\n"
862 "The address of the local host using the loopback device.\n"
864 "@defvar INADDR_BROADCAST\n"
865 "The broadcast address on the local network.\n"
867 "@defvar INADDR_NONE\n"
870 "For a socket of family @code{AF_INET6}, @var{address}\n"
871 "must be an integer IPv6 address and @var{args}\n"
872 "may be up to three integers:\n"
873 "port [flowinfo] [scope_id],\n"
874 "where flowinfo and scope_id default to zero.\n\n"
875 "The return value is unspecified.")
876 #define FUNC_NAME s_scm_bind
878 struct sockaddr
*soka
;
882 sock
= SCM_COERCE_OUTPORT (sock
);
883 SCM_VALIDATE_OPFPORT (1, sock
);
884 SCM_VALIDATE_INUM (2, fam
);
885 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
887 fd
= SCM_FPORT_FDES (sock
);
888 if (bind (fd
, soka
, size
) == -1)
890 int save_errno
= errno
;
897 return SCM_UNSPECIFIED
;
901 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
902 (SCM sock
, SCM backlog
),
903 "Enable @var{sock} to accept connection\n"
904 "requests. @var{backlog} is an integer specifying\n"
905 "the maximum length of the queue for pending connections.\n"
906 "If the queue fills, new clients will fail to connect until\n"
907 "the server calls @code{accept} to accept a connection from\n"
909 "The return value is unspecified.")
910 #define FUNC_NAME s_scm_listen
913 sock
= SCM_COERCE_OUTPORT (sock
);
914 SCM_VALIDATE_OPFPORT (1, sock
);
915 SCM_VALIDATE_INUM (2, backlog
);
916 fd
= SCM_FPORT_FDES (sock
);
917 if (listen (fd
, SCM_INUM (backlog
)) == -1)
919 return SCM_UNSPECIFIED
;
923 /* Put the components of a sockaddr into a new SCM vector. */
925 scm_addr_vector (const struct sockaddr
*address
, int addr_size
,
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
);
940 SCM_VECTOR_SET(result
, 0, scm_ulong2num ((unsigned long) fam
));
941 SCM_VECTOR_SET(result
, 1, scm_ulong2num (ntohl (nad
->sin_addr
.s_addr
)));
942 SCM_VECTOR_SET(result
, 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 SCM_VECTOR_SET(result
, 0, scm_ulong2num ((unsigned long) fam
));
952 SCM_VECTOR_SET(result
, 1, ipv6_net_to_num (nad
->sin6_addr
.s6_addr
));
953 SCM_VECTOR_SET(result
, 2, scm_ulong2num ((unsigned long) ntohs (nad
->sin6_port
)));
954 SCM_VECTOR_SET(result
, 3, scm_ulong2num ((unsigned long) nad
->sin6_flowinfo
));
955 #ifdef HAVE_SIN6_SCOPE_ID
956 SCM_VECTOR_SET(result
, 4, scm_ulong2num ((unsigned long) nad
->sin6_scope_id
));
958 SCM_VECTOR_SET(result
, 4, SCM_INUM0
);
963 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
966 const struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
968 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
970 SCM_VECTOR_SET(result
, 0, scm_ulong2num ((unsigned long) fam
));
971 /* When addr_size is not enough to cover sun_path, do not try
973 if (addr_size
<= offsetof (struct sockaddr_un
, sun_path
))
974 SCM_VECTOR_SET(result
, 1, SCM_BOOL_F
);
976 SCM_VECTOR_SET(result
, 1, scm_mem2string (nad
->sun_path
,
977 strlen (nad
->sun_path
)));
982 scm_misc_error (proc
, "Unrecognised address family: ~A",
983 scm_list_1 (SCM_MAKINUM (fam
)));
988 /* calculate the size of a buffer large enough to hold any supported
989 sockaddr type. if the buffer isn't large enough, certain system
990 calls will return a truncated address. */
992 #if defined (HAVE_UNIX_DOMAIN_SOCKETS)
993 #define MAX_SIZE_UN sizeof (struct sockaddr_un)
995 #define MAX_SIZE_UN 0
998 #if defined (HAVE_IPV6)
999 #define MAX_SIZE_IN6 sizeof (struct sockaddr_in6)
1001 #define MAX_SIZE_IN6 0
1004 #define MAX_ADDR_SIZE max (max (sizeof (struct sockaddr_in), MAX_SIZE_IN6),\
1007 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
1009 "Accept a connection on a bound, listening socket.\n"
1011 "are no pending connections in the queue, wait until\n"
1012 "one is available unless the non-blocking option has been\n"
1013 "set on the socket.\n\n"
1014 "The return value is a\n"
1015 "pair in which the @emph{car} is a new socket port for the\n"
1017 "the @emph{cdr} is an object with address information about the\n"
1018 "client which initiated the connection.\n\n"
1019 "@var{sock} does not become part of the\n"
1020 "connection and will continue to accept new requests.")
1021 #define FUNC_NAME s_scm_accept
1027 int addr_size
= MAX_ADDR_SIZE
;
1028 char max_addr
[MAX_ADDR_SIZE
];
1029 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1031 sock
= SCM_COERCE_OUTPORT (sock
);
1032 SCM_VALIDATE_OPFPORT (1, sock
);
1033 fd
= SCM_FPORT_FDES (sock
);
1034 newfd
= accept (fd
, addr
, &addr_size
);
1037 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
1038 address
= scm_addr_vector (addr
, addr_size
, FUNC_NAME
);
1039 return scm_cons (newsock
, address
);
1043 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
1045 "Return the address of @var{sock}, in the same form as the\n"
1046 "object returned by @code{accept}. On many systems the address\n"
1047 "of a socket in the @code{AF_FILE} namespace cannot be read.")
1048 #define FUNC_NAME s_scm_getsockname
1051 int addr_size
= MAX_ADDR_SIZE
;
1052 char max_addr
[MAX_ADDR_SIZE
];
1053 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1055 sock
= SCM_COERCE_OUTPORT (sock
);
1056 SCM_VALIDATE_OPFPORT (1, sock
);
1057 fd
= SCM_FPORT_FDES (sock
);
1058 if (getsockname (fd
, addr
, &addr_size
) == -1)
1060 return scm_addr_vector (addr
, addr_size
, FUNC_NAME
);
1064 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
1066 "Return the address that @var{sock}\n"
1067 "is connected to, in the same form as the object returned by\n"
1068 "@code{accept}. On many systems the address of a socket in the\n"
1069 "@code{AF_FILE} namespace cannot be read.")
1070 #define FUNC_NAME s_scm_getpeername
1073 int addr_size
= MAX_ADDR_SIZE
;
1074 char max_addr
[MAX_ADDR_SIZE
];
1075 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1077 sock
= SCM_COERCE_OUTPORT (sock
);
1078 SCM_VALIDATE_OPFPORT (1, sock
);
1079 fd
= SCM_FPORT_FDES (sock
);
1080 if (getpeername (fd
, addr
, &addr_size
) == -1)
1082 return scm_addr_vector (addr
, addr_size
, FUNC_NAME
);
1086 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
1087 (SCM sock
, SCM buf
, SCM flags
),
1088 "Receive data from a socket port.\n"
1089 "@var{sock} must already\n"
1090 "be bound to the address from which data is to be received.\n"
1091 "@var{buf} is a string into which\n"
1092 "the data will be written. The size of @var{buf} limits\n"
1094 "data which can be received: in the case of packet\n"
1095 "protocols, if a packet larger than this limit is encountered\n"
1097 "will be irrevocably lost.\n\n"
1098 "The optional @var{flags} argument is a value or\n"
1099 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1100 "The value returned is the number of bytes read from the\n"
1102 "Note that the data is read directly from the socket file\n"
1104 "any unread buffered port data is ignored.")
1105 #define FUNC_NAME s_scm_recv
1111 SCM_VALIDATE_OPFPORT (1, sock
);
1112 SCM_VALIDATE_STRING (2, buf
);
1113 SCM_VALIDATE_INUM_DEF_COPY (3, flags
,0, flg
);
1114 fd
= SCM_FPORT_FDES (sock
);
1116 SCM_SYSCALL (rv
= recv (fd
, SCM_STRING_CHARS (buf
), SCM_STRING_LENGTH (buf
), flg
));
1120 return SCM_MAKINUM (rv
);
1124 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
1125 (SCM sock
, SCM message
, SCM flags
),
1126 "Transmit the string @var{message} on a socket port @var{sock}.\n"
1127 "@var{sock} must already be bound to a destination address. The\n"
1128 "value returned is the number of bytes transmitted --\n"
1129 "it's possible for\n"
1130 "this to be less than the length of @var{message}\n"
1131 "if the socket is\n"
1132 "set to be non-blocking. The optional @var{flags} argument\n"
1134 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1135 "Note that the data is written directly to the socket\n"
1136 "file descriptor:\n"
1137 "any unflushed buffered port data is ignored.")
1138 #define FUNC_NAME s_scm_send
1144 sock
= SCM_COERCE_OUTPORT (sock
);
1145 SCM_VALIDATE_OPFPORT (1, sock
);
1146 SCM_VALIDATE_STRING (2, message
);
1147 SCM_VALIDATE_INUM_DEF_COPY (3, flags
,0, flg
);
1148 fd
= SCM_FPORT_FDES (sock
);
1150 SCM_SYSCALL (rv
= send (fd
, SCM_STRING_CHARS (message
), SCM_STRING_LENGTH (message
), flg
));
1153 return SCM_MAKINUM (rv
);
1157 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
1158 (SCM sock
, SCM str
, SCM flags
, SCM start
, SCM end
),
1159 "Return data from the socket port @var{sock} and also\n"
1160 "information about where the data was received from.\n"
1161 "@var{sock} must already be bound to the address from which\n"
1162 "data is to be received. @code{str}, is a string into which the\n"
1163 "data will be written. The size of @var{str} limits the amount\n"
1164 "of data which can be received: in the case of packet protocols,\n"
1165 "if a packet larger than this limit is encountered then some\n"
1166 "data will be irrevocably lost.\n\n"
1167 "The optional @var{flags} argument is a value or bitwise OR of\n"
1168 "@code{MSG_OOB}, @code{MSG_PEEK}, @code{MSG_DONTROUTE} etc.\n\n"
1169 "The value returned is a pair: the @emph{car} is the number of\n"
1170 "bytes read from the socket and the @emph{cdr} an address object\n"
1171 "in the same form as returned by @code{accept}. The address\n"
1172 "will given as @code{#f} if not available, as is usually the\n"
1173 "case for stream sockets.\n\n"
1174 "The @var{start} and @var{end} arguments specify a substring of\n"
1175 "@var{str} to which the data should be written.\n\n"
1176 "Note that the data is read directly from the socket file\n"
1177 "descriptor: any unread buffered port data is ignored.")
1178 #define FUNC_NAME s_scm_recvfrom
1187 int addr_size
= MAX_ADDR_SIZE
;
1188 char max_addr
[MAX_ADDR_SIZE
];
1189 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1191 SCM_VALIDATE_OPFPORT (1, sock
);
1192 fd
= SCM_FPORT_FDES (sock
);
1193 SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, str
, buf
, 4, start
, offset
,
1195 if (SCM_UNBNDP (flags
))
1198 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
1200 /* recvfrom will not necessarily return an address. usually nothing
1201 is returned for stream sockets. */
1202 addr
->sa_family
= AF_UNSPEC
;
1203 SCM_SYSCALL (rv
= recvfrom (fd
, buf
+ offset
,
1208 if (addr
->sa_family
!= AF_UNSPEC
)
1209 address
= scm_addr_vector (addr
, addr_size
, FUNC_NAME
);
1211 address
= SCM_BOOL_F
;
1213 return scm_cons (SCM_MAKINUM (rv
), address
);
1217 SCM_DEFINE (scm_sendto
, "sendto", 4, 0, 1,
1218 (SCM sock
, SCM message
, SCM fam
, SCM address
, SCM args_and_flags
),
1219 "Transmit the string @var{message} on the socket port\n"
1221 "destination address is specified using the @var{fam},\n"
1222 "@var{address} and\n"
1223 "@var{args_and_flags} arguments, in a similar way to the\n"
1224 "@code{connect} procedure. @var{args_and_flags} contains\n"
1225 "the usual connection arguments optionally followed by\n"
1226 "a flags argument, which is a value or\n"
1227 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1228 "The value returned is the number of bytes transmitted --\n"
1229 "it's possible for\n"
1230 "this to be less than the length of @var{message} if the\n"
1232 "set to be non-blocking.\n"
1233 "Note that the data is written directly to the socket\n"
1234 "file descriptor:\n"
1235 "any unflushed buffered port data is ignored.")
1236 #define FUNC_NAME s_scm_sendto
1241 struct sockaddr
*soka
;
1244 sock
= SCM_COERCE_OUTPORT (sock
);
1245 SCM_VALIDATE_FPORT (1, sock
);
1246 SCM_VALIDATE_STRING (2, message
);
1247 SCM_VALIDATE_INUM (3, fam
);
1248 fd
= SCM_FPORT_FDES (sock
);
1249 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args_and_flags
, 4,
1251 if (SCM_NULLP (args_and_flags
))
1255 SCM_VALIDATE_CONS (5, args_and_flags
);
1256 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
1258 SCM_SYSCALL (rv
= sendto (fd
, SCM_STRING_CHARS (message
),
1259 SCM_STRING_LENGTH (message
),
1263 int save_errno
= errno
;
1269 return SCM_MAKINUM (rv
);
1278 /* protocol families. */
1280 scm_c_define ("AF_UNSPEC", SCM_MAKINUM (AF_UNSPEC
));
1283 scm_c_define ("AF_UNIX", SCM_MAKINUM (AF_UNIX
));
1286 scm_c_define ("AF_INET", SCM_MAKINUM (AF_INET
));
1289 scm_c_define ("AF_INET6", SCM_MAKINUM (AF_INET6
));
1293 scm_c_define ("PF_UNSPEC", SCM_MAKINUM (PF_UNSPEC
));
1296 scm_c_define ("PF_UNIX", SCM_MAKINUM (PF_UNIX
));
1299 scm_c_define ("PF_INET", SCM_MAKINUM (PF_INET
));
1302 scm_c_define ("PF_INET6", SCM_MAKINUM (PF_INET6
));
1305 /* standard addresses. */
1307 scm_c_define ("INADDR_ANY", scm_ulong2num (INADDR_ANY
));
1309 #ifdef INADDR_BROADCAST
1310 scm_c_define ("INADDR_BROADCAST", scm_ulong2num (INADDR_BROADCAST
));
1313 scm_c_define ("INADDR_NONE", scm_ulong2num (INADDR_NONE
));
1315 #ifdef INADDR_LOOPBACK
1316 scm_c_define ("INADDR_LOOPBACK", scm_ulong2num (INADDR_LOOPBACK
));
1321 scm_c_define ("SOCK_STREAM", SCM_MAKINUM (SOCK_STREAM
));
1324 scm_c_define ("SOCK_DGRAM", SCM_MAKINUM (SOCK_DGRAM
));
1327 scm_c_define ("SOCK_RAW", SCM_MAKINUM (SOCK_RAW
));
1330 /* setsockopt level. */
1332 scm_c_define ("SOL_SOCKET", SCM_MAKINUM (SOL_SOCKET
));
1335 scm_c_define ("SOL_IP", SCM_MAKINUM (SOL_IP
));
1338 scm_c_define ("SOL_TCP", SCM_MAKINUM (SOL_TCP
));
1341 scm_c_define ("SOL_UDP", SCM_MAKINUM (SOL_UDP
));
1344 /* setsockopt names. */
1346 scm_c_define ("SO_DEBUG", SCM_MAKINUM (SO_DEBUG
));
1349 scm_c_define ("SO_REUSEADDR", SCM_MAKINUM (SO_REUSEADDR
));
1352 scm_c_define ("SO_STYLE", SCM_MAKINUM (SO_STYLE
));
1355 scm_c_define ("SO_TYPE", SCM_MAKINUM (SO_TYPE
));
1358 scm_c_define ("SO_ERROR", SCM_MAKINUM (SO_ERROR
));
1361 scm_c_define ("SO_DONTROUTE", SCM_MAKINUM (SO_DONTROUTE
));
1364 scm_c_define ("SO_BROADCAST", SCM_MAKINUM (SO_BROADCAST
));
1367 scm_c_define ("SO_SNDBUF", SCM_MAKINUM (SO_SNDBUF
));
1370 scm_c_define ("SO_RCVBUF", SCM_MAKINUM (SO_RCVBUF
));
1373 scm_c_define ("SO_KEEPALIVE", SCM_MAKINUM (SO_KEEPALIVE
));
1376 scm_c_define ("SO_OOBINLINE", SCM_MAKINUM (SO_OOBINLINE
));
1379 scm_c_define ("SO_NO_CHECK", SCM_MAKINUM (SO_NO_CHECK
));
1382 scm_c_define ("SO_PRIORITY", SCM_MAKINUM (SO_PRIORITY
));
1385 scm_c_define ("SO_LINGER", SCM_MAKINUM (SO_LINGER
));
1388 /* recv/send options. */
1390 scm_c_define ("MSG_OOB", SCM_MAKINUM (MSG_OOB
));
1393 scm_c_define ("MSG_PEEK", SCM_MAKINUM (MSG_PEEK
));
1395 #ifdef MSG_DONTROUTE
1396 scm_c_define ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE
));
1400 scm_i_init_socket_Win32 ();
1403 scm_add_feature ("socket");
1405 #include "libguile/socket.x"