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"
67 #include <sys/types.h>
68 #ifdef HAVE_WINSOCK2_H
71 #include <sys/socket.h>
72 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
75 #include <netinet/in.h>
77 #include <arpa/inet.h>
80 #if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
81 #define SUN_LEN(ptr) ((size_t) (((struct sockaddr_un *) 0)->sun_path) \
82 + strlen ((ptr)->sun_path))
85 #if !defined (HAVE_UINT32_T)
87 typedef unsigned int uint32_t;
88 #elif SIZEOF_LONG == 4
89 typedef unsigned long uint32_t;
91 #error can not define uint32_t
95 /* we are not currently using socklen_t. it's not defined on all systems,
96 so would need to be checked by configure. in the meantime, plain
97 int is the best alternative. */
101 SCM_DEFINE (scm_htons
, "htons", 1, 0, 0,
103 "Convert a 16 bit quantity from host to network byte ordering.\n"
104 "@var{value} is packed into 2 bytes, which are then converted\n"
105 "and returned as a new integer.")
106 #define FUNC_NAME s_scm_htons
110 SCM_VALIDATE_INUM_COPY (1, value
, c_in
);
111 if (c_in
!= SCM_INUM (value
))
112 SCM_OUT_OF_RANGE (1, value
);
114 return SCM_MAKINUM (htons (c_in
));
118 SCM_DEFINE (scm_ntohs
, "ntohs", 1, 0, 0,
120 "Convert a 16 bit quantity from network to host byte ordering.\n"
121 "@var{value} is packed into 2 bytes, which are then converted\n"
122 "and returned as a new integer.")
123 #define FUNC_NAME s_scm_ntohs
127 SCM_VALIDATE_INUM_COPY (1, value
, c_in
);
128 if (c_in
!= SCM_INUM (value
))
129 SCM_OUT_OF_RANGE (1, value
);
131 return SCM_MAKINUM (ntohs (c_in
));
135 SCM_DEFINE (scm_htonl
, "htonl", 1, 0, 0,
137 "Convert a 32 bit quantity from host to network byte ordering.\n"
138 "@var{value} is packed into 4 bytes, which are then converted\n"
139 "and returned as a new integer.")
140 #define FUNC_NAME s_scm_htonl
142 uint32_t c_in
= SCM_NUM2ULONG (1, value
);
144 return scm_ulong2num (htonl (c_in
));
148 SCM_DEFINE (scm_ntohl
, "ntohl", 1, 0, 0,
150 "Convert a 32 bit quantity from network to host byte ordering.\n"
151 "@var{value} is packed into 4 bytes, which are then converted\n"
152 "and returned as a new integer.")
153 #define FUNC_NAME s_scm_ntohl
155 uint32_t c_in
= SCM_NUM2ULONG (1, value
);
157 return scm_ulong2num (ntohl (c_in
));
161 #ifndef HAVE_INET_ATON
162 /* for our definition in inet_aton.c, not usually needed. */
163 extern int inet_aton ();
166 SCM_DEFINE (scm_inet_aton
, "inet-aton", 1, 0, 0,
168 "Convert an IPv4 Internet address from printable string\n"
169 "(dotted decimal notation) to an integer. E.g.,\n\n"
171 "(inet-aton \"127.0.0.1\") @result{} 2130706433\n"
173 #define FUNC_NAME s_scm_inet_aton
177 SCM_VALIDATE_STRING (1, address
);
178 if (inet_aton (SCM_STRING_CHARS (address
), &soka
) == 0)
179 SCM_MISC_ERROR ("bad address", SCM_EOL
);
180 return scm_ulong2num (ntohl (soka
.s_addr
));
185 SCM_DEFINE (scm_inet_ntoa
, "inet-ntoa", 1, 0, 0,
187 "Convert an IPv4 Internet address to a printable\n"
188 "(dotted decimal notation) string. E.g.,\n\n"
190 "(inet-ntoa 2130706433) @result{} \"127.0.0.1\"\n"
192 #define FUNC_NAME s_scm_inet_ntoa
197 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, inetid
));
198 s
= inet_ntoa (addr
);
199 answer
= scm_mem2string (s
, strlen (s
));
204 #ifdef HAVE_INET_NETOF
205 SCM_DEFINE (scm_inet_netof
, "inet-netof", 1, 0, 0,
207 "Return the network number part of the given IPv4\n"
208 "Internet address. E.g.,\n\n"
210 "(inet-netof 2130706433) @result{} 127\n"
212 #define FUNC_NAME s_scm_inet_netof
215 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
216 return scm_ulong2num ((unsigned long) inet_netof (addr
));
221 #ifdef HAVE_INET_LNAOF
222 SCM_DEFINE (scm_lnaof
, "inet-lnaof", 1, 0, 0,
224 "Return the local-address-with-network part of the given\n"
225 "IPv4 Internet address, using the obsolete class A/B/C system.\n"
228 "(inet-lnaof 2130706433) @result{} 1\n"
230 #define FUNC_NAME s_scm_lnaof
233 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
234 return scm_ulong2num ((unsigned long) inet_lnaof (addr
));
239 #ifdef HAVE_INET_MAKEADDR
240 SCM_DEFINE (scm_inet_makeaddr
, "inet-makeaddr", 2, 0, 0,
242 "Make an IPv4 Internet address by combining the network number\n"
243 "@var{net} with the local-address-within-network number\n"
244 "@var{lna}. E.g.,\n\n"
246 "(inet-makeaddr 127 1) @result{} 2130706433\n"
248 #define FUNC_NAME s_scm_inet_makeaddr
251 unsigned long netnum
;
252 unsigned long lnanum
;
254 netnum
= SCM_NUM2ULONG (1, net
);
255 lnanum
= SCM_NUM2ULONG (2, lna
);
256 addr
= inet_makeaddr (netnum
, lnanum
);
257 return scm_ulong2num (ntohl (addr
.s_addr
));
264 /* flip a 128 bit IPv6 address between host and network order. */
265 #ifdef WORDS_BIGENDIAN
266 #define FLIP_NET_HOST_128(addr)
268 #define FLIP_NET_HOST_128(addr)\
272 for (i = 0; i < 8; i++)\
276 (addr)[i] = (addr)[15 - i];\
282 /* convert a 128 bit IPv6 address in network order to a host ordered
284 static SCM
ipv6_net_to_num (const char *src
)
286 int big_digits
= 128 / SCM_BITSPERDIG
;
287 const int bytes_per_dig
= SCM_BITSPERDIG
/ 8;
292 memcpy (addr
, src
, 16);
293 /* get rid of leading zeros. */
294 while (big_digits
> 0)
298 memcpy (&test
, ptr
, bytes_per_dig
);
301 ptr
+= bytes_per_dig
;
304 FLIP_NET_HOST_128 (addr
);
305 if (big_digits
* bytes_per_dig
<= sizeof (unsigned long))
307 /* this is just so that we use INUM where possible. */
308 unsigned long l_addr
;
310 memcpy (&l_addr
, addr
, sizeof (unsigned long));
311 result
= scm_ulong2num (l_addr
);
315 result
= scm_i_mkbig (big_digits
, 0);
316 memcpy (SCM_BDIGITS (result
), addr
, big_digits
* bytes_per_dig
);
321 /* convert a host ordered SCM integer to a 128 bit IPv6 address in
323 static void ipv6_num_to_net (SCM src
, char *dst
)
327 uint32_t addr
= htonl (SCM_INUM (src
));
330 memcpy (dst
+ 12, &addr
, 4);
335 memcpy (dst
, SCM_BDIGITS (src
),
336 SCM_NUMDIGS (src
) * (SCM_BITSPERDIG
/ 8));
337 FLIP_NET_HOST_128 (dst
);
341 /* check that an SCM variable contains an IPv6 integer address. */
342 #define VALIDATE_INET6(which_arg, address)\
343 if (SCM_INUMP (address))\
344 SCM_ASSERT_RANGE (which_arg, address, SCM_INUM (address) >= 0);\
347 SCM_VALIDATE_BIGINT (which_arg, address);\
348 SCM_ASSERT_RANGE (which_arg, address,\
349 !SCM_BIGSIGN (address)\
351 * SCM_NUMDIGS (address) <= 128));\
354 #ifdef HAVE_INET_PTON
355 SCM_DEFINE (scm_inet_pton
, "inet-pton", 2, 0, 0,
356 (SCM family
, SCM address
),
357 "Convert a string containing a printable network address to\n"
358 "an integer address. Note that unlike the C version of this\n"
360 "the result is an integer with normal host byte ordering.\n"
361 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
363 "(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
364 "(inet-pton AF_INET6 \"::1\") @result{} 1\n"
366 #define FUNC_NAME s_scm_inet_pton
373 SCM_VALIDATE_INUM_COPY (1, family
, af
);
374 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
375 SCM_VALIDATE_STRING_COPY (2, address
, src
);
376 rv
= inet_pton (af
, src
, dst
);
380 SCM_MISC_ERROR ("Bad address", SCM_EOL
);
382 return scm_ulong2num (ntohl (*(uint32_t *) dst
));
384 return ipv6_net_to_num ((char *) dst
);
389 #ifdef HAVE_INET_NTOP
390 SCM_DEFINE (scm_inet_ntop
, "inet-ntop", 2, 0, 0,
391 (SCM family
, SCM address
),
392 "Convert a network address into a printable string.\n"
393 "Note that unlike the C version of this function,\n"
394 "the input is an integer with normal host byte ordering.\n"
395 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
397 "(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
398 "(inet-ntop AF_INET6 (- (expt 2 128) 1)) @result{}\n"
399 "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\n"
401 #define FUNC_NAME s_scm_inet_ntop
404 #ifdef INET6_ADDRSTRLEN
405 char dst
[INET6_ADDRSTRLEN
];
411 SCM_VALIDATE_INUM_COPY (1, family
, af
);
412 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
414 *(uint32_t *) addr6
= htonl (SCM_NUM2ULONG (2, address
));
417 VALIDATE_INET6 (2, address
);
418 ipv6_num_to_net (address
, addr6
);
420 if (inet_ntop (af
, &addr6
, dst
, sizeof dst
) == NULL
)
422 return scm_makfrom0str (dst
);
427 #endif /* HAVE_IPV6 */
429 SCM_SYMBOL (sym_socket
, "socket");
431 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
433 SCM_DEFINE (scm_socket
, "socket", 3, 0, 0,
434 (SCM family
, SCM style
, SCM proto
),
435 "Return a new socket port of the type specified by @var{family},\n"
436 "@var{style} and @var{proto}. All three parameters are\n"
437 "integers. Supported values for @var{family} are\n"
438 "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
439 "Typical values for @var{style} are @code{SOCK_STREAM},\n"
440 "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
441 "@var{proto} can be obtained from a protocol name using\n"
442 "@code{getprotobyname}. A value of zero specifies the default\n"
443 "protocol, which is usually right.\n\n"
444 "A single socket port cannot by used for communication until it\n"
445 "has been connected to another socket.")
446 #define FUNC_NAME s_scm_socket
450 SCM_VALIDATE_INUM (1, family
);
451 SCM_VALIDATE_INUM (2, style
);
452 SCM_VALIDATE_INUM (3, proto
);
453 fd
= socket (SCM_INUM (family
), SCM_INUM (style
), SCM_INUM (proto
));
456 return SCM_SOCK_FD_TO_PORT (fd
);
460 #ifdef HAVE_SOCKETPAIR
461 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
462 (SCM family
, SCM style
, SCM proto
),
463 "Return a pair of connected (but unnamed) socket ports of the\n"
464 "type specified by @var{family}, @var{style} and @var{proto}.\n"
465 "Many systems support only socket pairs of the @code{AF_UNIX}\n"
466 "family. Zero is likely to be the only meaningful value for\n"
468 #define FUNC_NAME s_scm_socketpair
473 SCM_VALIDATE_INUM (1,family
);
474 SCM_VALIDATE_INUM (2,style
);
475 SCM_VALIDATE_INUM (3,proto
);
477 fam
= SCM_INUM (family
);
479 if (socketpair (fam
, SCM_INUM (style
), SCM_INUM (proto
), fd
) == -1)
482 return scm_cons (SCM_SOCK_FD_TO_PORT (fd
[0]), SCM_SOCK_FD_TO_PORT (fd
[1]));
487 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
488 (SCM sock
, SCM level
, SCM optname
),
489 "Return the value of a particular socket option for the socket\n"
490 "port @var{sock}. @var{level} is an integer code for type of\n"
491 "option being requested, e.g., @code{SOL_SOCKET} for\n"
492 "socket-level options. @var{optname} is an integer code for the\n"
493 "option required and should be specified using one of the\n"
494 "symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n\n"
495 "The returned value is typically an integer but @code{SO_LINGER}\n"
496 "returns a pair of integers.")
497 #define FUNC_NAME s_scm_getsockopt
500 /* size of optval is the largest supported option. */
501 #ifdef HAVE_STRUCT_LINGER
502 char optval
[sizeof (struct linger
)];
503 int optlen
= sizeof (struct linger
);
505 char optval
[sizeof (size_t)];
506 int optlen
= sizeof (size_t);
511 sock
= SCM_COERCE_OUTPORT (sock
);
512 SCM_VALIDATE_OPFPORT (1, sock
);
513 SCM_VALIDATE_INUM_COPY (2, level
, ilevel
);
514 SCM_VALIDATE_INUM_COPY (3, optname
, ioptname
);
516 fd
= SCM_FPORT_FDES (sock
);
517 if (getsockopt (fd
, ilevel
, ioptname
, (void *) optval
, &optlen
) == -1)
520 if (ilevel
== SOL_SOCKET
)
523 if (ioptname
== SO_LINGER
)
525 #ifdef HAVE_STRUCT_LINGER
526 struct linger
*ling
= (struct linger
*) optval
;
528 return scm_cons (scm_long2num (ling
->l_onoff
),
529 scm_long2num (ling
->l_linger
));
531 return scm_cons (scm_long2num (*(int *) optval
),
539 || ioptname
== SO_SNDBUF
542 || ioptname
== SO_RCVBUF
546 return scm_long2num (*(size_t *) optval
);
549 return scm_long2num (*(int *) optval
);
553 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
554 (SCM sock
, SCM level
, SCM optname
, SCM value
),
555 "Set the value of a particular socket option for the socket\n"
556 "port @var{sock}. @var{level} is an integer code for type of option\n"
557 "being set, e.g., @code{SOL_SOCKET} for socket-level options.\n"
558 "@var{optname} is an\n"
559 "integer code for the option to set and should be specified using one of\n"
560 "the symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n"
561 "@var{value} is the value to which the option should be set. For\n"
562 "most options this must be an integer, but for @code{SO_LINGER} it must\n"
564 "The return value is unspecified.")
565 #define FUNC_NAME s_scm_setsockopt
569 /* size of optval is the largest supported option. */
570 #ifdef HAVE_STRUCT_LINGER
571 char optval
[sizeof (struct linger
)];
573 char optval
[sizeof (size_t)];
575 int ilevel
, ioptname
;
577 sock
= SCM_COERCE_OUTPORT (sock
);
579 SCM_VALIDATE_OPFPORT (1, sock
);
580 SCM_VALIDATE_INUM_COPY (2, level
, ilevel
);
581 SCM_VALIDATE_INUM_COPY (3, optname
, ioptname
);
583 fd
= SCM_FPORT_FDES (sock
);
585 if (ilevel
== SOL_SOCKET
)
588 if (ioptname
== SO_LINGER
)
590 #ifdef HAVE_STRUCT_LINGER
594 SCM_ASSERT (SCM_CONSP (value
), value
, SCM_ARG4
, FUNC_NAME
);
595 lv
= SCM_NUM2LONG (4, SCM_CAR (value
));
596 ling
.l_onoff
= (int) lv
;
597 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
.l_onoff
== lv
);
598 lv
= SCM_NUM2LONG (4, SCM_CDR (value
));
599 ling
.l_linger
= (int) lv
;
600 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
.l_linger
== lv
);
601 optlen
= (int) sizeof (struct linger
);
602 memcpy (optval
, (void *) &ling
, optlen
);
607 SCM_ASSERT (SCM_CONSP (value
), value
, SCM_ARG4
, FUNC_NAME
);
608 /* timeout is ignored, but may as well validate it. */
609 lv
= SCM_NUM2LONG (4, SCM_CDR (value
));
611 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
== lv
);
612 lv
= SCM_NUM2LONG (4, SCM_CAR (value
));
614 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
== lv
);
615 optlen
= (int) sizeof (int);
616 (*(int *) optval
) = ling
;
623 || ioptname
== SO_SNDBUF
626 || ioptname
== SO_RCVBUF
630 long lv
= SCM_NUM2LONG (4, value
);
632 optlen
= (int) sizeof (size_t);
633 (*(size_t *) optval
) = (size_t) lv
;
638 /* Most options take an int. */
639 long lv
= SCM_NUM2LONG (4, value
);
642 SCM_ASSERT_RANGE (SCM_ARG4
, value
, val
== lv
);
643 optlen
= (int) sizeof (int);
644 (*(int *) optval
) = val
;
646 if (setsockopt (fd
, ilevel
, ioptname
, (void *) optval
, optlen
) == -1)
648 return SCM_UNSPECIFIED
;
652 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
654 "Sockets can be closed simply by using @code{close-port}. The\n"
655 "@code{shutdown} procedure allows reception or tranmission on a\n"
656 "connection to be shut down individually, according to the parameter\n"
660 "Stop receiving data for this socket. If further data arrives, reject it.\n"
662 "Stop trying to transmit data from this socket. Discard any\n"
663 "data waiting to be sent. Stop looking for acknowledgement of\n"
664 "data already sent; don't retransmit it if it is lost.\n"
666 "Stop both reception and transmission.\n"
668 "The return value is unspecified.")
669 #define FUNC_NAME s_scm_shutdown
672 sock
= SCM_COERCE_OUTPORT (sock
);
673 SCM_VALIDATE_OPFPORT (1,sock
);
674 SCM_VALIDATE_INUM (2,how
);
675 SCM_ASSERT_RANGE(2,how
,0 <= SCM_INUM (how
) && 2 >= SCM_INUM (how
));
676 fd
= SCM_FPORT_FDES (sock
);
677 if (shutdown (fd
, SCM_INUM (how
)) == -1)
679 return SCM_UNSPECIFIED
;
683 /* convert fam/address/args into a sockaddr of the appropriate type.
684 args is modified by removing the arguments actually used.
685 which_arg and proc are used when reporting errors:
686 which_arg is the position of address in the original argument list.
687 proc is the name of the original procedure.
688 size returns the size of the structure allocated. */
690 static struct sockaddr
*
691 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
692 const char *proc
, int *size
)
693 #define FUNC_NAME proc
699 struct sockaddr_in
*soka
;
703 SCM_VALIDATE_ULONG_COPY (which_arg
, address
, addr
);
704 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
705 SCM_VALIDATE_INUM_COPY (which_arg
+ 1, SCM_CAR (*args
), port
);
706 *args
= SCM_CDR (*args
);
707 soka
= (struct sockaddr_in
*) malloc (sizeof (struct sockaddr_in
));
709 scm_memory_error (proc
);
710 /* 4.4BSD-style interface includes sin_len member and defines SIN_LEN,
713 soka
->sin_len
= sizeof (struct sockaddr_in
);
715 soka
->sin_family
= AF_INET
;
716 soka
->sin_addr
.s_addr
= htonl (addr
);
717 soka
->sin_port
= htons (port
);
718 *size
= sizeof (struct sockaddr_in
);
719 return (struct sockaddr
*) soka
;
726 struct sockaddr_in6
*soka
;
727 unsigned long flowinfo
= 0;
728 unsigned long scope_id
= 0;
730 VALIDATE_INET6 (which_arg
, address
);
731 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
732 SCM_VALIDATE_INUM_COPY (which_arg
+ 1, SCM_CAR (*args
), port
);
733 *args
= SCM_CDR (*args
);
734 if (SCM_CONSP (*args
))
736 SCM_VALIDATE_ULONG_COPY (which_arg
+ 2, SCM_CAR (*args
), flowinfo
);
737 *args
= SCM_CDR (*args
);
738 if (SCM_CONSP (*args
))
740 SCM_VALIDATE_ULONG_COPY (which_arg
+ 3, SCM_CAR (*args
),
742 *args
= SCM_CDR (*args
);
745 soka
= (struct sockaddr_in6
*) malloc (sizeof (struct sockaddr_in6
));
747 scm_memory_error (proc
);
749 soka
->sin6_len
= sizeof (struct sockaddr_in6
);
751 soka
->sin6_family
= AF_INET6
;
752 ipv6_num_to_net (address
, soka
->sin6_addr
.s6_addr
);
753 soka
->sin6_port
= htons (port
);
754 soka
->sin6_flowinfo
= flowinfo
;
755 #ifdef HAVE_SIN6_SCOPE_ID
756 soka
->sin6_scope_id
= scope_id
;
758 *size
= sizeof (struct sockaddr_in6
);
759 return (struct sockaddr
*) soka
;
762 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
765 struct sockaddr_un
*soka
;
768 SCM_ASSERT (SCM_STRINGP (address
), address
, which_arg
, proc
);
769 /* the static buffer size in sockaddr_un seems to be arbitrary
770 and not necessarily a hard limit. e.g., the glibc manual
771 suggests it may be possible to declare it size 0. let's
772 ignore it. if the O/S doesn't like the size it will cause
773 connect/bind etc., to fail. sun_path is always the last
774 member of the structure. */
775 addr_size
= sizeof (struct sockaddr_un
)
776 + max (0, SCM_STRING_LENGTH (address
) + 1 - (sizeof soka
->sun_path
));
777 soka
= (struct sockaddr_un
*) malloc (addr_size
);
779 scm_memory_error (proc
);
780 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
781 soka
->sun_family
= AF_UNIX
;
782 memcpy (soka
->sun_path
, SCM_STRING_CHARS (address
),
783 SCM_STRING_LENGTH (address
));
784 *size
= SUN_LEN (soka
);
785 return (struct sockaddr
*) soka
;
789 scm_out_of_range (proc
, SCM_MAKINUM (fam
));
794 SCM_DEFINE (scm_connect
, "connect", 3, 0, 1,
795 (SCM sock
, SCM fam
, SCM address
, SCM args
),
796 "Initiate a connection from a socket using a specified address\n"
797 "family to the address\n"
798 "specified by @var{address} and possibly @var{args}.\n"
799 "The format required for @var{address}\n"
800 "and @var{args} depends on the family of the socket.\n\n"
801 "For a socket of family @code{AF_UNIX},\n"
802 "only @var{address} is specified and must be a string with the\n"
803 "filename where the socket is to be created.\n\n"
804 "For a socket of family @code{AF_INET},\n"
805 "@var{address} must be an integer IPv4 host address and\n"
806 "@var{args} must be a single integer port number.\n\n"
807 "For a socket of family @code{AF_INET6},\n"
808 "@var{address} must be an integer IPv6 host address and\n"
809 "@var{args} may be up to three integers:\n"
810 "port [flowinfo] [scope_id],\n"
811 "where flowinfo and scope_id default to zero.\n\n"
812 "The return value is unspecified.")
813 #define FUNC_NAME s_scm_connect
816 struct sockaddr
*soka
;
819 sock
= SCM_COERCE_OUTPORT (sock
);
820 SCM_VALIDATE_OPFPORT (1,sock
);
821 SCM_VALIDATE_INUM (2,fam
);
822 fd
= SCM_FPORT_FDES (sock
);
823 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
825 if (connect (fd
, soka
, size
) == -1)
827 int save_errno
= errno
;
834 return SCM_UNSPECIFIED
;
838 SCM_DEFINE (scm_bind
, "bind", 3, 0, 1,
839 (SCM sock
, SCM fam
, SCM address
, SCM args
),
840 "Assign an address to the socket port @var{sock}.\n"
841 "Generally this only needs to be done for server sockets,\n"
842 "so they know where to look for incoming connections. A socket\n"
843 "without an address will be assigned one automatically when it\n"
844 "starts communicating.\n\n"
845 "The format of @var{address} and @var{args} depends\n"
846 "on the family of the socket.\n\n"
847 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
848 "is specified and must be a string with the filename where\n"
849 "the socket is to be created.\n\n"
850 "For a socket of family @code{AF_INET}, @var{address}\n"
851 "must be an integer IPv4 address and @var{args}\n"
852 "must be a single integer port number.\n\n"
853 "The values of the following variables can also be used for\n"
855 "@defvar INADDR_ANY\n"
856 "Allow connections from any address.\n"
858 "@defvar INADDR_LOOPBACK\n"
859 "The address of the local host using the loopback device.\n"
861 "@defvar INADDR_BROADCAST\n"
862 "The broadcast address on the local network.\n"
864 "@defvar INADDR_NONE\n"
867 "For a socket of family @code{AF_INET6}, @var{address}\n"
868 "must be an integer IPv6 address and @var{args}\n"
869 "may be up to three integers:\n"
870 "port [flowinfo] [scope_id],\n"
871 "where flowinfo and scope_id default to zero.\n\n"
872 "The return value is unspecified.")
873 #define FUNC_NAME s_scm_bind
875 struct sockaddr
*soka
;
879 sock
= SCM_COERCE_OUTPORT (sock
);
880 SCM_VALIDATE_OPFPORT (1, sock
);
881 SCM_VALIDATE_INUM (2, fam
);
882 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
884 fd
= SCM_FPORT_FDES (sock
);
885 if (bind (fd
, soka
, size
) == -1)
887 int save_errno
= errno
;
894 return SCM_UNSPECIFIED
;
898 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
899 (SCM sock
, SCM backlog
),
900 "Enable @var{sock} to accept connection\n"
901 "requests. @var{backlog} is an integer specifying\n"
902 "the maximum length of the queue for pending connections.\n"
903 "If the queue fills, new clients will fail to connect until\n"
904 "the server calls @code{accept} to accept a connection from\n"
906 "The return value is unspecified.")
907 #define FUNC_NAME s_scm_listen
910 sock
= SCM_COERCE_OUTPORT (sock
);
911 SCM_VALIDATE_OPFPORT (1,sock
);
912 SCM_VALIDATE_INUM (2,backlog
);
913 fd
= SCM_FPORT_FDES (sock
);
914 if (listen (fd
, SCM_INUM (backlog
)) == -1)
916 return SCM_UNSPECIFIED
;
920 /* Put the components of a sockaddr into a new SCM vector. */
922 scm_addr_vector (const struct sockaddr
*address
, const char *proc
)
924 short int fam
= address
->sa_family
;
932 const struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
934 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
935 ve
= SCM_VELTS (result
);
936 ve
[0] = scm_ulong2num ((unsigned long) fam
);
937 ve
[1] = scm_ulong2num (ntohl (nad
->sin_addr
.s_addr
));
938 ve
[2] = scm_ulong2num ((unsigned long) ntohs (nad
->sin_port
));
944 const struct sockaddr_in6
*nad
= (struct sockaddr_in6
*) address
;
946 result
= scm_c_make_vector (5, SCM_UNSPECIFIED
);
947 ve
= SCM_VELTS (result
);
948 ve
[0] = scm_ulong2num ((unsigned long) fam
);
949 ve
[1] = ipv6_net_to_num (nad
->sin6_addr
.s6_addr
);
950 ve
[2] = scm_ulong2num ((unsigned long) ntohs (nad
->sin6_port
));
951 ve
[3] = scm_ulong2num ((unsigned long) nad
->sin6_flowinfo
);
952 #ifdef HAVE_SIN6_SCOPE_ID
953 ve
[4] = scm_ulong2num ((unsigned long) nad
->sin6_scope_id
);
960 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
963 const struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
965 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
966 ve
= SCM_VELTS (result
);
967 ve
[0] = scm_ulong2num ((unsigned long) fam
);
968 ve
[1] = scm_mem2string (nad
->sun_path
, strlen (nad
->sun_path
));
973 scm_misc_error (proc
, "Unrecognised address family: ~A",
974 scm_list_1 (SCM_MAKINUM (fam
)));
979 /* calculate the size of a buffer large enough to hold any supported
980 sockaddr type. if the buffer isn't large enough, certain system
981 calls will return a truncated address. */
983 #if defined (HAVE_UNIX_DOMAIN_SOCKETS)
984 #define MAX_SIZE_UN sizeof (struct sockaddr_un)
986 #define MAX_SIZE_UN 0
989 #if defined (HAVE_IPV6)
990 #define MAX_SIZE_IN6 sizeof (struct sockaddr_in6)
992 #define MAX_SIZE_IN6 0
995 #define MAX_ADDR_SIZE max (max (sizeof (struct sockaddr_in), MAX_SIZE_IN6),\
998 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
1000 "Accept a connection on a bound, listening socket.\n"
1002 "are no pending connections in the queue, wait until\n"
1003 "one is available unless the non-blocking option has been\n"
1004 "set on the socket.\n\n"
1005 "The return value is a\n"
1006 "pair in which the @emph{car} is a new socket port for the\n"
1008 "the @emph{cdr} is an object with address information about the\n"
1009 "client which initiated the connection.\n\n"
1010 "@var{sock} does not become part of the\n"
1011 "connection and will continue to accept new requests.")
1012 #define FUNC_NAME s_scm_accept
1018 int addr_size
= MAX_ADDR_SIZE
;
1019 char max_addr
[MAX_ADDR_SIZE
];
1020 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1022 sock
= SCM_COERCE_OUTPORT (sock
);
1023 SCM_VALIDATE_OPFPORT (1, sock
);
1024 fd
= SCM_FPORT_FDES (sock
);
1025 newfd
= accept (fd
, addr
, &addr_size
);
1028 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
1029 address
= scm_addr_vector (addr
, FUNC_NAME
);
1030 return scm_cons (newsock
, address
);
1034 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
1036 "Return the address of @var{sock}, in the same form as the\n"
1037 "object returned by @code{accept}. On many systems the address\n"
1038 "of a socket in the @code{AF_FILE} namespace cannot be read.")
1039 #define FUNC_NAME s_scm_getsockname
1042 int addr_size
= MAX_ADDR_SIZE
;
1043 char max_addr
[MAX_ADDR_SIZE
];
1044 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1046 sock
= SCM_COERCE_OUTPORT (sock
);
1047 SCM_VALIDATE_OPFPORT (1,sock
);
1048 fd
= SCM_FPORT_FDES (sock
);
1049 if (getsockname (fd
, addr
, &addr_size
) == -1)
1051 return scm_addr_vector (addr
, FUNC_NAME
);
1055 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
1057 "Return the address that @var{sock}\n"
1058 "is connected to, in the same form as the object returned by\n"
1059 "@code{accept}. On many systems the address of a socket in the\n"
1060 "@code{AF_FILE} namespace cannot be read.")
1061 #define FUNC_NAME s_scm_getpeername
1064 int addr_size
= MAX_ADDR_SIZE
;
1065 char max_addr
[MAX_ADDR_SIZE
];
1066 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1068 sock
= SCM_COERCE_OUTPORT (sock
);
1069 SCM_VALIDATE_OPFPORT (1,sock
);
1070 fd
= SCM_FPORT_FDES (sock
);
1071 if (getpeername (fd
, addr
, &addr_size
) == -1)
1073 return scm_addr_vector (addr
, FUNC_NAME
);
1077 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
1078 (SCM sock
, SCM buf
, SCM flags
),
1079 "Receive data from a socket port.\n"
1080 "@var{sock} must already\n"
1081 "be bound to the address from which data is to be received.\n"
1082 "@var{buf} is a string into which\n"
1083 "the data will be written. The size of @var{buf} limits\n"
1085 "data which can be received: in the case of packet\n"
1086 "protocols, if a packet larger than this limit is encountered\n"
1088 "will be irrevocably lost.\n\n"
1089 "The optional @var{flags} argument is a value or\n"
1090 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1091 "The value returned is the number of bytes read from the\n"
1093 "Note that the data is read directly from the socket file\n"
1095 "any unread buffered port data is ignored.")
1096 #define FUNC_NAME s_scm_recv
1102 SCM_VALIDATE_OPFPORT (1,sock
);
1103 SCM_VALIDATE_STRING (2,buf
);
1104 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
1105 fd
= SCM_FPORT_FDES (sock
);
1107 SCM_SYSCALL (rv
= recv (fd
, SCM_STRING_CHARS (buf
), SCM_STRING_LENGTH (buf
), flg
));
1111 return SCM_MAKINUM (rv
);
1115 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
1116 (SCM sock
, SCM message
, SCM flags
),
1117 "Transmit the string @var{message} on a socket port @var{sock}.\n"
1118 "@var{sock} must already be bound to a destination address. The\n"
1119 "value returned is the number of bytes transmitted --\n"
1120 "it's possible for\n"
1121 "this to be less than the length of @var{message}\n"
1122 "if the socket is\n"
1123 "set to be non-blocking. The optional @var{flags} argument\n"
1125 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1126 "Note that the data is written directly to the socket\n"
1127 "file descriptor:\n"
1128 "any unflushed buffered port data is ignored.")
1129 #define FUNC_NAME s_scm_send
1135 sock
= SCM_COERCE_OUTPORT (sock
);
1136 SCM_VALIDATE_OPFPORT (1,sock
);
1137 SCM_VALIDATE_STRING (2, message
);
1138 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
1139 fd
= SCM_FPORT_FDES (sock
);
1141 SCM_SYSCALL (rv
= send (fd
, SCM_STRING_CHARS (message
), SCM_STRING_LENGTH (message
), flg
));
1144 return SCM_MAKINUM (rv
);
1148 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
1149 (SCM sock
, SCM str
, SCM flags
, SCM start
, SCM end
),
1150 "Return data from the socket port @var{sock} and also\n"
1151 "information about where the data was received from.\n"
1152 "@var{sock} must already be bound to the address from which\n"
1153 "data is to be received. @code{str}, is a string into which the\n"
1154 "data will be written. The size of @var{str} limits the amount\n"
1155 "of data which can be received: in the case of packet protocols,\n"
1156 "if a packet larger than this limit is encountered then some\n"
1157 "data will be irrevocably lost.\n\n"
1158 "The optional @var{flags} argument is a value or bitwise OR of\n"
1159 "@code{MSG_OOB}, @code{MSG_PEEK}, @code{MSG_DONTROUTE} etc.\n\n"
1160 "The value returned is a pair: the @emph{car} is the number of\n"
1161 "bytes read from the socket and the @emph{cdr} an address object\n"
1162 "in the same form as returned by @code{accept}. The address\n"
1163 "will given as @code{#f} if not available, as is usually the\n"
1164 "case for stream sockets.\n\n"
1165 "The @var{start} and @var{end} arguments specify a substring of\n"
1166 "@var{str} to which the data should be written.\n\n"
1167 "Note that the data is read directly from the socket file\n"
1168 "descriptor: any unread buffered port data is ignored.")
1169 #define FUNC_NAME s_scm_recvfrom
1178 int addr_size
= MAX_ADDR_SIZE
;
1179 char max_addr
[MAX_ADDR_SIZE
];
1180 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1182 SCM_VALIDATE_OPFPORT (1,sock
);
1183 fd
= SCM_FPORT_FDES (sock
);
1184 SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, str
, buf
, 4, start
, offset
,
1186 if (SCM_UNBNDP (flags
))
1189 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
1191 /* recvfrom will not necessarily return an address. usually nothing
1192 is returned for stream sockets. */
1193 addr
->sa_family
= AF_UNSPEC
;
1194 SCM_SYSCALL (rv
= recvfrom (fd
, buf
+ offset
,
1199 if (addr
->sa_family
!= AF_UNSPEC
)
1200 address
= scm_addr_vector (addr
, FUNC_NAME
);
1202 address
= SCM_BOOL_F
;
1204 return scm_cons (SCM_MAKINUM (rv
), address
);
1208 SCM_DEFINE (scm_sendto
, "sendto", 4, 0, 1,
1209 (SCM sock
, SCM message
, SCM fam
, SCM address
, SCM args_and_flags
),
1210 "Transmit the string @var{message} on the socket port\n"
1212 "destination address is specified using the @var{fam},\n"
1213 "@var{address} and\n"
1214 "@var{args_and_flags} arguments, in a similar way to the\n"
1215 "@code{connect} procedure. @var{args_and_flags} contains\n"
1216 "the usual connection arguments optionally followed by\n"
1217 "a flags argument, which is a value or\n"
1218 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1219 "The value returned is the number of bytes transmitted --\n"
1220 "it's possible for\n"
1221 "this to be less than the length of @var{message} if the\n"
1223 "set to be non-blocking.\n"
1224 "Note that the data is written directly to the socket\n"
1225 "file descriptor:\n"
1226 "any unflushed buffered port data is ignored.")
1227 #define FUNC_NAME s_scm_sendto
1232 struct sockaddr
*soka
;
1235 sock
= SCM_COERCE_OUTPORT (sock
);
1236 SCM_VALIDATE_FPORT (1,sock
);
1237 SCM_VALIDATE_STRING (2, message
);
1238 SCM_VALIDATE_INUM (3,fam
);
1239 fd
= SCM_FPORT_FDES (sock
);
1240 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args_and_flags
, 4,
1242 if (SCM_NULLP (args_and_flags
))
1246 SCM_VALIDATE_CONS (5,args_and_flags
);
1247 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
1249 SCM_SYSCALL (rv
= sendto (fd
, SCM_STRING_CHARS (message
),
1250 SCM_STRING_LENGTH (message
),
1254 int save_errno
= errno
;
1260 return SCM_MAKINUM (rv
);
1269 /* protocol families. */
1271 scm_c_define ("AF_UNSPEC", SCM_MAKINUM (AF_UNSPEC
));
1274 scm_c_define ("AF_UNIX", SCM_MAKINUM (AF_UNIX
));
1277 scm_c_define ("AF_INET", SCM_MAKINUM (AF_INET
));
1280 scm_c_define ("AF_INET6", SCM_MAKINUM (AF_INET6
));
1284 scm_c_define ("PF_UNSPEC", SCM_MAKINUM (PF_UNSPEC
));
1287 scm_c_define ("PF_UNIX", SCM_MAKINUM (PF_UNIX
));
1290 scm_c_define ("PF_INET", SCM_MAKINUM (PF_INET
));
1293 scm_c_define ("PF_INET6", SCM_MAKINUM (PF_INET6
));
1296 /* standard addresses. */
1298 scm_c_define ("INADDR_ANY", scm_ulong2num (INADDR_ANY
));
1300 #ifdef INADDR_BROADCAST
1301 scm_c_define ("INADDR_BROADCAST", scm_ulong2num (INADDR_BROADCAST
));
1304 scm_c_define ("INADDR_NONE", scm_ulong2num (INADDR_NONE
));
1306 #ifdef INADDR_LOOPBACK
1307 scm_c_define ("INADDR_LOOPBACK", scm_ulong2num (INADDR_LOOPBACK
));
1312 scm_c_define ("SOCK_STREAM", SCM_MAKINUM (SOCK_STREAM
));
1315 scm_c_define ("SOCK_DGRAM", SCM_MAKINUM (SOCK_DGRAM
));
1318 scm_c_define ("SOCK_RAW", SCM_MAKINUM (SOCK_RAW
));
1321 /* setsockopt level. */
1323 scm_c_define ("SOL_SOCKET", SCM_MAKINUM (SOL_SOCKET
));
1326 scm_c_define ("SOL_IP", SCM_MAKINUM (SOL_IP
));
1329 scm_c_define ("SOL_TCP", SCM_MAKINUM (SOL_TCP
));
1332 scm_c_define ("SOL_UDP", SCM_MAKINUM (SOL_UDP
));
1335 /* setsockopt names. */
1337 scm_c_define ("SO_DEBUG", SCM_MAKINUM (SO_DEBUG
));
1340 scm_c_define ("SO_REUSEADDR", SCM_MAKINUM (SO_REUSEADDR
));
1343 scm_c_define ("SO_STYLE", SCM_MAKINUM (SO_STYLE
));
1346 scm_c_define ("SO_TYPE", SCM_MAKINUM (SO_TYPE
));
1349 scm_c_define ("SO_ERROR", SCM_MAKINUM (SO_ERROR
));
1352 scm_c_define ("SO_DONTROUTE", SCM_MAKINUM (SO_DONTROUTE
));
1355 scm_c_define ("SO_BROADCAST", SCM_MAKINUM (SO_BROADCAST
));
1358 scm_c_define ("SO_SNDBUF", SCM_MAKINUM (SO_SNDBUF
));
1361 scm_c_define ("SO_RCVBUF", SCM_MAKINUM (SO_RCVBUF
));
1364 scm_c_define ("SO_KEEPALIVE", SCM_MAKINUM (SO_KEEPALIVE
));
1367 scm_c_define ("SO_OOBINLINE", SCM_MAKINUM (SO_OOBINLINE
));
1370 scm_c_define ("SO_NO_CHECK", SCM_MAKINUM (SO_NO_CHECK
));
1373 scm_c_define ("SO_PRIORITY", SCM_MAKINUM (SO_PRIORITY
));
1376 scm_c_define ("SO_LINGER", SCM_MAKINUM (SO_LINGER
));
1379 /* recv/send options. */
1381 scm_c_define ("MSG_OOB", SCM_MAKINUM (MSG_OOB
));
1384 scm_c_define ("MSG_PEEK", SCM_MAKINUM (MSG_PEEK
));
1386 #ifdef MSG_DONTROUTE
1387 scm_c_define ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE
));
1391 scm_i_init_socket_Win32 ();
1394 scm_add_feature ("socket");
1396 #ifndef SCM_MAGIC_SNARFER
1397 #include "libguile/socket.x"