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. */
42 /* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
43 gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
49 #include "libguile/_scm.h"
50 #include "libguile/unif.h"
51 #include "libguile/feature.h"
52 #include "libguile/fports.h"
53 #include "libguile/strings.h"
54 #include "libguile/vectors.h"
56 #include "libguile/validate.h"
57 #include "libguile/socket.h"
65 #include <sys/types.h>
66 #include <sys/socket.h>
67 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
70 #include <netinet/in.h>
72 #include <arpa/inet.h>
74 #if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
75 #define SUN_LEN(ptr) ((size_t) (((struct sockaddr_un *) 0)->sun_path) \
76 + strlen ((ptr)->sun_path))
79 #if !defined (HAVE_UINT32_T)
81 typedef unsigned int uint32_t;
82 #elif SIZEOF_LONG == 4
83 typedef unsigned long uint32_t;
85 #error can not define uint32_t
89 /* we are not currently using socklen_t. it's not defined on all systems,
90 so would need to be checked by configure. in the meantime, plain
91 int is the best alternative. */
95 SCM_DEFINE (scm_htons
, "htons", 1, 0, 0,
97 "Convert a 16 bit quantity from host to network byte ordering.\n"
98 "@var{value} is packed into 2 bytes, which are then converted\n"
99 "and returned as a new integer.")
100 #define FUNC_NAME s_scm_htons
104 SCM_VALIDATE_INUM_COPY (1, value
, c_in
);
105 if (c_in
!= SCM_INUM (value
))
106 SCM_OUT_OF_RANGE (1, value
);
108 return SCM_MAKINUM (htons (c_in
));
112 SCM_DEFINE (scm_ntohs
, "ntohs", 1, 0, 0,
114 "Convert a 16 bit quantity from network to host byte ordering.\n"
115 "@var{value} is packed into 2 bytes, which are then converted\n"
116 "and returned as a new integer.")
117 #define FUNC_NAME s_scm_ntohs
121 SCM_VALIDATE_INUM_COPY (1, value
, c_in
);
122 if (c_in
!= SCM_INUM (value
))
123 SCM_OUT_OF_RANGE (1, value
);
125 return SCM_MAKINUM (ntohs (c_in
));
129 SCM_DEFINE (scm_htonl
, "htonl", 1, 0, 0,
131 "Convert a 32 bit quantity from host to network byte ordering.\n"
132 "@var{value} is packed into 4 bytes, which are then converted\n"
133 "and returned as a new integer.")
134 #define FUNC_NAME s_scm_htonl
136 uint32_t c_in
= SCM_NUM2ULONG (1, value
);
138 return scm_ulong2num (htonl (c_in
));
142 SCM_DEFINE (scm_ntohl
, "ntohl", 1, 0, 0,
144 "Convert a 32 bit quantity from network to host byte ordering.\n"
145 "@var{value} is packed into 4 bytes, which are then converted\n"
146 "and returned as a new integer.")
147 #define FUNC_NAME s_scm_ntohl
149 uint32_t c_in
= SCM_NUM2ULONG (1, value
);
151 return scm_ulong2num (ntohl (c_in
));
155 #ifndef HAVE_INET_ATON
156 /* for our definition in inet_aton.c, not usually needed. */
157 extern int inet_aton ();
160 SCM_DEFINE (scm_inet_aton
, "inet-aton", 1, 0, 0,
162 "Convert an IPv4 Internet address from printable string\n"
163 "(dotted decimal notation) to an integer. E.g.,\n\n"
165 "(inet-aton \"127.0.0.1\") @result{} 2130706433\n"
167 #define FUNC_NAME s_scm_inet_aton
171 SCM_VALIDATE_STRING (1, address
);
172 SCM_STRING_COERCE_0TERMINATION_X (address
);
173 if (inet_aton (SCM_STRING_CHARS (address
), &soka
) == 0)
174 SCM_MISC_ERROR ("bad address", SCM_EOL
);
175 return scm_ulong2num (ntohl (soka
.s_addr
));
180 SCM_DEFINE (scm_inet_ntoa
, "inet-ntoa", 1, 0, 0,
182 "Convert an IPv4 Internet address to a printable\n"
183 "(dotted decimal notation) string. E.g.,\n\n"
185 "(inet-ntoa 2130706433) @result{} \"127.0.0.1\"\n"
187 #define FUNC_NAME s_scm_inet_ntoa
192 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, inetid
));
193 s
= inet_ntoa (addr
);
194 answer
= scm_makfromstr (s
, strlen (s
), 0);
199 #ifdef HAVE_INET_NETOF
200 SCM_DEFINE (scm_inet_netof
, "inet-netof", 1, 0, 0,
202 "Return the network number part of the given IPv4\n"
203 "Internet address. E.g.,\n\n"
205 "(inet-netof 2130706433) @result{} 127\n"
207 #define FUNC_NAME s_scm_inet_netof
210 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
211 return scm_ulong2num ((unsigned long) inet_netof (addr
));
216 #ifdef HAVE_INET_LNAOF
217 SCM_DEFINE (scm_lnaof
, "inet-lnaof", 1, 0, 0,
219 "Return the local-address-with-network part of the given\n"
220 "IPv4 Internet address, using the obsolete class A/B/C system.\n"
223 "(inet-lnaof 2130706433) @result{} 1\n"
225 #define FUNC_NAME s_scm_lnaof
228 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
229 return scm_ulong2num ((unsigned long) inet_lnaof (addr
));
234 #ifdef HAVE_INET_MAKEADDR
235 SCM_DEFINE (scm_inet_makeaddr
, "inet-makeaddr", 2, 0, 0,
237 "Make an IPv4 Internet address by combining the network number\n"
238 "@var{net} with the local-address-within-network number\n"
239 "@var{lna}. E.g.,\n\n"
241 "(inet-makeaddr 127 1) @result{} 2130706433\n"
243 #define FUNC_NAME s_scm_inet_makeaddr
246 unsigned long netnum
;
247 unsigned long lnanum
;
249 netnum
= SCM_NUM2ULONG (1, net
);
250 lnanum
= SCM_NUM2ULONG (2, lna
);
251 addr
= inet_makeaddr (netnum
, lnanum
);
252 return scm_ulong2num (ntohl (addr
.s_addr
));
259 /* flip a 128 bit IPv6 address between host and network order. */
260 #ifdef WORDS_BIGENDIAN
261 #define FLIP_NET_HOST_128(addr)
263 #define FLIP_NET_HOST_128(addr)\
267 for (i = 0; i < 8; i++)\
271 (addr)[i] = (addr)[15 - i];\
277 /* convert a 128 bit IPv6 address in network order to a host ordered
279 static SCM
ipv6_net_to_num (const char *src
)
281 int big_digits
= 128 / SCM_BITSPERDIG
;
282 const int bytes_per_dig
= SCM_BITSPERDIG
/ 8;
287 memcpy (addr
, src
, 16);
288 /* get rid of leading zeros. */
289 while (big_digits
> 0)
293 memcpy (&test
, ptr
, bytes_per_dig
);
296 ptr
+= bytes_per_dig
;
299 FLIP_NET_HOST_128 (addr
);
300 if (big_digits
* bytes_per_dig
<= sizeof (unsigned long))
302 /* this is just so that we use INUM where possible. */
303 unsigned long l_addr
;
305 memcpy (&l_addr
, addr
, sizeof (unsigned long));
306 result
= scm_ulong2num (l_addr
);
310 result
= scm_mkbig (big_digits
, 0);
311 memcpy (SCM_BDIGITS (result
), addr
, big_digits
* bytes_per_dig
);
316 /* convert a host ordered SCM integer to a 128 bit IPv6 address in
318 static void ipv6_num_to_net (SCM src
, char *dst
)
322 uint32_t addr
= htonl (SCM_INUM (src
));
325 memcpy (dst
+ 12, &addr
, 4);
330 memcpy (dst
, SCM_BDIGITS (src
),
331 SCM_NUMDIGS (src
) * (SCM_BITSPERDIG
/ 8));
332 FLIP_NET_HOST_128 (dst
);
336 /* check that an SCM variable contains an IPv6 integer address. */
337 #define VALIDATE_INET6(which_arg, address)\
338 if (SCM_INUMP (address))\
339 SCM_ASSERT_RANGE (which_arg, address, SCM_INUM (address) >= 0);\
342 SCM_VALIDATE_BIGINT (which_arg, address);\
343 SCM_ASSERT_RANGE (which_arg, address,\
344 !SCM_BIGSIGN (address)\
346 * SCM_NUMDIGS (address) <= 128));\
349 #ifdef HAVE_INET_PTON
350 SCM_DEFINE (scm_inet_pton
, "inet-pton", 2, 0, 0,
351 (SCM family
, SCM address
),
352 "Convert a string containing a printable network address to\n"
353 "an integer address. Note that unlike the C version of this\n"
355 "the result is an integer with normal host byte ordering.\n"
356 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
358 "(inet-pton AF_INET "127.0.0.1") @result{} 2130706433\n"
359 "(inet-pton AF_INET6 "::1") @result{} 1\n"
361 #define FUNC_NAME s_scm_inet_pton
368 SCM_VALIDATE_INUM_COPY (1, family
, af
);
369 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
370 SCM_VALIDATE_STRING_COPY (2, address
, src
);
371 rv
= inet_pton (af
, src
, dst
);
375 SCM_MISC_ERROR ("Bad address", SCM_EOL
);
377 return scm_ulong2num (ntohl (*(uint32_t *) dst
));
379 return ipv6_net_to_num ((char *) dst
);
384 #ifdef HAVE_INET_NTOP
385 SCM_DEFINE (scm_inet_ntop
, "inet-ntop", 2, 0, 0,
386 (SCM family
, SCM address
),
387 "Convert a network address into a printable string.\n"
388 "Note that unlike the C version of this function,\n"
389 "the input is an integer with normal host byte ordering.\n"
390 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
392 "(inet-ntop AF_INET 2130706433) @result{} "127.0.0.1"\n"
393 "(inet-ntop AF_INET6 (- (expt 2 128) 1)) @result{}\n"
394 "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\n"
396 #define FUNC_NAME s_scm_inet_ntop
399 #ifdef INET6_ADDRSTRLEN
400 char dst
[INET6_ADDRSTRLEN
];
406 SCM_VALIDATE_INUM_COPY (1, family
, af
);
407 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
409 *(uint32_t *) addr6
= htonl (SCM_NUM2ULONG (2, address
));
412 VALIDATE_INET6 (2, address
);
413 ipv6_num_to_net (address
, addr6
);
415 if (inet_ntop (af
, &addr6
, dst
, sizeof dst
) == NULL
)
417 return scm_makfrom0str (dst
);
422 #endif /* AF_INET6 */
424 SCM_SYMBOL (sym_socket
, "socket");
426 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
428 SCM_DEFINE (scm_socket
, "socket", 3, 0, 0,
429 (SCM family
, SCM style
, SCM proto
),
430 "Return a new socket port of the type specified by @var{family},\n"
431 "@var{style} and @var{proto}. All three parameters are\n"
432 "integers. Supported values for @var{family} are\n"
433 "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
434 "Typical values for @var{style} are @code{SOCK_STREAM},\n"
435 "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
436 "@var{proto} can be obtained from a protocol name using\n"
437 "@code{getprotobyname}. A value of zero specifies the default\n"
438 "protocol, which is usually right.\n\n"
439 "A single socket port cannot by used for communication until it\n"
440 "has been connected to another socket.")
441 #define FUNC_NAME s_scm_socket
445 SCM_VALIDATE_INUM (1, family
);
446 SCM_VALIDATE_INUM (2, style
);
447 SCM_VALIDATE_INUM (3, proto
);
448 fd
= socket (SCM_INUM (family
), SCM_INUM (style
), SCM_INUM (proto
));
451 return SCM_SOCK_FD_TO_PORT (fd
);
455 #ifdef HAVE_SOCKETPAIR
456 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
457 (SCM family
, SCM style
, SCM proto
),
458 "Return a pair of connected (but unnamed) socket ports of the\n"
459 "type specified by @var{family}, @var{style} and @var{proto}.\n"
460 "Many systems support only socket pairs of the @code{AF_UNIX}\n"
461 "family. Zero is likely to be the only meaningful value for\n"
463 #define FUNC_NAME s_scm_socketpair
468 SCM_VALIDATE_INUM (1,family
);
469 SCM_VALIDATE_INUM (2,style
);
470 SCM_VALIDATE_INUM (3,proto
);
472 fam
= SCM_INUM (family
);
474 if (socketpair (fam
, SCM_INUM (style
), SCM_INUM (proto
), fd
) == -1)
477 return scm_cons (SCM_SOCK_FD_TO_PORT (fd
[0]), SCM_SOCK_FD_TO_PORT (fd
[1]));
482 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
483 (SCM sock
, SCM level
, SCM optname
),
484 "Return the value of a particular socket option for the socket\n"
485 "port @var{sock}. @var{level} is an integer code for type of\n"
486 "option being requested, e.g., @code{SOL_SOCKET} for\n"
487 "socket-level options. @var{optname} is an integer code for the\n"
488 "option required and should be specified using one of the\n"
489 "symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n\n"
490 "The returned value is typically an integer but @code{SO_LINGER}\n"
491 "returns a pair of integers.")
492 #define FUNC_NAME s_scm_getsockopt
495 /* size of optval is the largest supported option. */
496 #ifdef HAVE_STRUCT_LINGER
497 char optval
[sizeof (struct linger
)];
498 int optlen
= sizeof (struct linger
);
500 char optval
[sizeof (scm_sizet
)];
501 int optlen
= sizeof (scm_sizet
);
506 sock
= SCM_COERCE_OUTPORT (sock
);
507 SCM_VALIDATE_OPFPORT (1, sock
);
508 SCM_VALIDATE_INUM_COPY (2, level
, ilevel
);
509 SCM_VALIDATE_INUM_COPY (3, optname
, ioptname
);
511 fd
= SCM_FPORT_FDES (sock
);
512 if (getsockopt (fd
, ilevel
, ioptname
, (void *) optval
, &optlen
) == -1)
515 if (ilevel
== SOL_SOCKET
)
518 if (ioptname
== SO_LINGER
)
520 #ifdef HAVE_STRUCT_LINGER
521 struct linger
*ling
= (struct linger
*) optval
;
523 return scm_cons (scm_long2num (ling
->l_onoff
),
524 scm_long2num (ling
->l_linger
));
526 return scm_cons (scm_long2num (*(int *) optval
)
534 || ioptname
== SO_SNDBUF
537 || ioptname
== SO_RCVBUF
541 return scm_long2num (*(scm_sizet
*) optval
);
544 return scm_long2num (*(int *) optval
);
548 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
549 (SCM sock
, SCM level
, SCM optname
, SCM value
),
550 "Set the value of a particular socket option for the socket\n"
551 "port @var{sock}. @var{level} is an integer code for type of option\n"
552 "being set, e.g., @code{SOL_SOCKET} for socket-level options.\n"
553 "@var{optname} is an\n"
554 "integer code for the option to set and should be specified using one of\n"
555 "the symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n"
556 "@var{value} is the value to which the option should be set. For\n"
557 "most options this must be an integer, but for @code{SO_LINGER} it must\n"
559 "The return value is unspecified.")
560 #define FUNC_NAME s_scm_setsockopt
564 /* size of optval is the largest supported option. */
565 #ifdef HAVE_STRUCT_LINGER
566 char optval
[sizeof (struct linger
)];
568 char optval
[sizeof (scm_sizet
)];
570 int ilevel
, ioptname
;
572 sock
= SCM_COERCE_OUTPORT (sock
);
574 SCM_VALIDATE_OPFPORT (1, sock
);
575 SCM_VALIDATE_INUM_COPY (2, level
, ilevel
);
576 SCM_VALIDATE_INUM_COPY (3, optname
, ioptname
);
578 fd
= SCM_FPORT_FDES (sock
);
580 if (ilevel
== SOL_SOCKET
)
583 if (ioptname
== SO_LINGER
)
585 #ifdef HAVE_STRUCT_LINGER
589 SCM_ASSERT (SCM_CONSP (value
), value
, SCM_ARG4
, FUNC_NAME
);
590 lv
= SCM_NUM2LONG (4, SCM_CAR (value
));
591 ling
.l_onoff
= (int) lv
;
592 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
.l_onoff
== lv
);
593 lv
= SCM_NUM2LONG (4, SCM_CDR (value
));
594 ling
.l_linger
= (int) lv
;
595 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
.l_linger
== lv
);
596 optlen
= (int) sizeof (struct linger
);
597 memcpy (optval
, (void *) &ling
, optlen
);
602 SCM_ASSERT (SCM_CONSP (value
), value
, SCM_ARG4
, FUNC_NAME
);
603 /* timeout is ignored, but may as well validate it. */
604 lv
= SCM_NUM2LONG (4, SCM_CDR (value
));
606 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
== lv
);
607 lv
= SCM_NUM2LONG (4, SCM_CAR (value
));
609 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
== lv
);
610 optlen
= (int) sizeof (int);
611 (*(int *) optval
) = ling
;
618 || ioptname
== SO_SNDBUF
621 || ioptname
== SO_RCVBUF
625 long lv
= SCM_NUM2LONG (4, value
);
627 optlen
= (int) sizeof (scm_sizet
);
628 (*(scm_sizet
*) optval
) = (scm_sizet
) lv
;
633 /* Most options take an int. */
634 long lv
= SCM_NUM2LONG (4, value
);
637 SCM_ASSERT_RANGE (SCM_ARG4
, value
, val
== lv
);
638 optlen
= (int) sizeof (int);
639 (*(int *) optval
) = val
;
641 if (setsockopt (fd
, ilevel
, ioptname
, (void *) optval
, optlen
) == -1)
643 return SCM_UNSPECIFIED
;
647 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
649 "Sockets can be closed simply by using @code{close-port}. The\n"
650 "@code{shutdown} procedure allows reception or tranmission on a\n"
651 "connection to be shut down individually, according to the parameter\n"
655 "Stop receiving data for this socket. If further data arrives, reject it.\n"
657 "Stop trying to transmit data from this socket. Discard any\n"
658 "data waiting to be sent. Stop looking for acknowledgement of\n"
659 "data already sent; don't retransmit it if it is lost.\n"
661 "Stop both reception and transmission.\n"
663 "The return value is unspecified.")
664 #define FUNC_NAME s_scm_shutdown
667 sock
= SCM_COERCE_OUTPORT (sock
);
668 SCM_VALIDATE_OPFPORT (1,sock
);
669 SCM_VALIDATE_INUM (2,how
);
670 SCM_ASSERT_RANGE(2,how
,0 <= SCM_INUM (how
) && 2 >= SCM_INUM (how
));
671 fd
= SCM_FPORT_FDES (sock
);
672 if (shutdown (fd
, SCM_INUM (how
)) == -1)
674 return SCM_UNSPECIFIED
;
678 /* convert fam/address/args into a sockaddr of the appropriate type.
679 args is modified by removing the arguments actually used.
680 which_arg and proc are used when reporting errors:
681 which_arg is the position of address in the original argument list.
682 proc is the name of the original procedure.
683 size returns the size of the structure allocated. */
685 static struct sockaddr
*
686 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
687 const char *proc
, int *size
)
688 #define FUNC_NAME proc
694 struct sockaddr_in
*soka
;
698 SCM_VALIDATE_ULONG_COPY (which_arg
, address
, addr
);
699 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
700 SCM_VALIDATE_INUM_COPY (which_arg
+ 1, SCM_CAR (*args
), port
);
701 *args
= SCM_CDR (*args
);
702 soka
= (struct sockaddr_in
*) malloc (sizeof (struct sockaddr_in
));
704 scm_memory_error (proc
);
705 /* 4.4BSD-style interface includes sin_len member and defines SIN_LEN,
708 soka
->sin_len
= sizeof (struct sockaddr_in
);
710 soka
->sin_family
= AF_INET
;
711 soka
->sin_addr
.s_addr
= htonl (addr
);
712 soka
->sin_port
= htons (port
);
713 *size
= sizeof (struct sockaddr_in
);
714 return (struct sockaddr
*) soka
;
721 struct sockaddr_in6
*soka
;
722 unsigned long flowinfo
= 0;
723 unsigned long scope_id
= 0;
725 VALIDATE_INET6 (which_arg
, address
);
726 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
727 SCM_VALIDATE_INUM_COPY (which_arg
+ 1, SCM_CAR (*args
), port
);
728 *args
= SCM_CDR (*args
);
729 if (SCM_CONSP (*args
))
731 SCM_VALIDATE_ULONG_COPY (which_arg
+ 2, SCM_CAR (*args
), flowinfo
);
732 *args
= SCM_CDR (*args
);
733 if (SCM_CONSP (*args
))
735 SCM_VALIDATE_ULONG_COPY (which_arg
+ 3, SCM_CAR (*args
),
737 *args
= SCM_CDR (*args
);
740 soka
= (struct sockaddr_in6
*) malloc (sizeof (struct sockaddr_in6
));
742 scm_memory_error (proc
);
744 soka
->sin6_len
= sizeof (struct sockaddr_in6
);
746 soka
->sin6_family
= AF_INET6
;
747 ipv6_num_to_net (address
, soka
->sin6_addr
.s6_addr
);
748 soka
->sin6_port
= htons (port
);
749 soka
->sin6_flowinfo
= flowinfo
;
750 #ifdef HAVE_SIN6_SCOPE_ID
751 soka
->sin6_scope_id
= scope_id
;
753 *size
= sizeof (struct sockaddr_in6
);
754 return (struct sockaddr
*) soka
;
757 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
760 struct sockaddr_un
*soka
;
763 SCM_ASSERT (SCM_STRINGP (address
), address
, which_arg
, proc
);
764 /* the static buffer size in sockaddr_un seems to be arbitrary
765 and not necessarily a hard limit. e.g., the glibc manual
766 suggests it may be possible to declare it size 0. let's
767 ignore it. if the O/S doesn't like the size it will cause
768 connect/bind etc., to fail. sun_path is always the last
769 member of the structure. */
770 addr_size
= sizeof (struct sockaddr_un
)
771 + max (0, SCM_STRING_LENGTH (address
) + 1 - (sizeof soka
->sun_path
));
772 soka
= (struct sockaddr_un
*) malloc (addr_size
);
774 scm_memory_error (proc
);
775 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
776 soka
->sun_family
= AF_UNIX
;
777 memcpy (soka
->sun_path
, SCM_STRING_CHARS (address
),
778 SCM_STRING_LENGTH (address
));
779 *size
= SUN_LEN (soka
);
780 return (struct sockaddr
*) soka
;
784 scm_out_of_range (proc
, SCM_MAKINUM (fam
));
789 SCM_DEFINE (scm_connect
, "connect", 3, 0, 1,
790 (SCM sock
, SCM fam
, SCM address
, SCM args
),
791 "Initiate a connection from a socket using a specified address\n"
792 "family to the address\n"
793 "specified by @var{address} and possibly @var{args}.\n"
794 "The format required for @var{address}\n"
795 "and @var{args} depends on the family of the socket.\n\n"
796 "For a socket of family @code{AF_UNIX},\n"
797 "only @var{address} is specified and must be a string with the\n"
798 "filename where the socket is to be created.\n\n"
799 "For a socket of family @code{AF_INET},\n"
800 "@var{address} must be an integer IPv4 host address and\n"
801 "@var{args} must be a single integer port number.\n\n"
802 "For a socket of family @code{AF_INET6},\n"
803 "@var{address} must be an integer IPv6 host address and\n"
804 "@var{args} may be up to three integers:\n"
805 "port [flowinfo] [scope_id],\n"
806 "where flowinfo and scope_id default to zero.\n\n"
807 "The return value is unspecified.")
808 #define FUNC_NAME s_scm_connect
811 struct sockaddr
*soka
;
814 sock
= SCM_COERCE_OUTPORT (sock
);
815 SCM_VALIDATE_OPFPORT (1,sock
);
816 SCM_VALIDATE_INUM (2,fam
);
817 fd
= SCM_FPORT_FDES (sock
);
818 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
820 if (connect (fd
, soka
, size
) == -1)
822 int save_errno
= errno
;
829 return SCM_UNSPECIFIED
;
833 SCM_DEFINE (scm_bind
, "bind", 3, 0, 1,
834 (SCM sock
, SCM fam
, SCM address
, SCM args
),
835 "Assign an address to the socket port @var{sock}.\n"
836 "Generally this only needs to be done for server sockets,\n"
837 "so they know where to look for incoming connections. A socket\n"
838 "without an address will be assigned one automatically when it\n"
839 "starts communicating.\n\n"
840 "The format of @var{address} and @var{args} depends\n"
841 "on the family of the socket.\n\n"
842 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
843 "is specified and must be a string with the filename where\n"
844 "the socket is to be created.\n\n"
845 "For a socket of family @code{AF_INET}, @var{address}\n"
846 "must be an integer IPv4 address and @var{args}\n"
847 "must be a single integer port number.\n\n"
848 "The values of the following variables can also be used for\n"
850 "@defvar INADDR_ANY\n"
851 "Allow connections from any address.\n"
853 "@defvar INADDR_LOOPBACK\n"
854 "The address of the local host using the loopback device.\n"
856 "@defvar INADDR_BROADCAST\n"
857 "The broadcast address on the local network.\n"
859 "@defvar INADDR_NONE\n"
862 "For a socket of family @code{AF_INET6}, @var{address}\n"
863 "must be an integer IPv6 address and @var{args}\n"
864 "may be up to three integers:\n"
865 "port [flowinfo] [scope_id],\n"
866 "where flowinfo and scope_id default to zero.\n\n"
867 "The return value is unspecified.")
868 #define FUNC_NAME s_scm_bind
870 struct sockaddr
*soka
;
874 sock
= SCM_COERCE_OUTPORT (sock
);
875 SCM_VALIDATE_OPFPORT (1, sock
);
876 SCM_VALIDATE_INUM (2, fam
);
877 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
879 fd
= SCM_FPORT_FDES (sock
);
880 if (bind (fd
, soka
, size
) == -1)
882 int save_errno
= errno
;
889 return SCM_UNSPECIFIED
;
893 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
894 (SCM sock
, SCM backlog
),
895 "Enable @var{sock} to accept connection\n"
896 "requests. @var{backlog} is an integer specifying\n"
897 "the maximum length of the queue for pending connections.\n"
898 "If the queue fills, new clients will fail to connect until\n"
899 "the server calls @code{accept} to accept a connection from\n"
901 "The return value is unspecified.")
902 #define FUNC_NAME s_scm_listen
905 sock
= SCM_COERCE_OUTPORT (sock
);
906 SCM_VALIDATE_OPFPORT (1,sock
);
907 SCM_VALIDATE_INUM (2,backlog
);
908 fd
= SCM_FPORT_FDES (sock
);
909 if (listen (fd
, SCM_INUM (backlog
)) == -1)
911 return SCM_UNSPECIFIED
;
915 /* Put the components of a sockaddr into a new SCM vector. */
917 scm_addr_vector (const struct sockaddr
*address
, const char *proc
)
919 short int fam
= address
->sa_family
;
927 const struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
929 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
930 ve
= SCM_VELTS (result
);
931 ve
[0] = scm_ulong2num ((unsigned long) fam
);
932 ve
[1] = scm_ulong2num (ntohl (nad
->sin_addr
.s_addr
));
933 ve
[2] = scm_ulong2num ((unsigned long) ntohs (nad
->sin_port
));
939 const struct sockaddr_in6
*nad
= (struct sockaddr_in6
*) address
;
941 result
= scm_c_make_vector (5, SCM_UNSPECIFIED
);
942 ve
= SCM_VELTS (result
);
943 ve
[0] = scm_ulong2num ((unsigned long) fam
);
944 ve
[1] = ipv6_net_to_num (nad
->sin6_addr
.s6_addr
);
945 ve
[2] = scm_ulong2num ((unsigned long) ntohs (nad
->sin6_port
));
946 ve
[3] = scm_ulong2num ((unsigned long) nad
->sin6_flowinfo
);
947 #ifdef HAVE_SIN6_SCOPE_ID
948 ve
[4] = scm_ulong2num ((unsigned long) nad
->sin6_scope_id
);
955 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
958 const struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
960 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
961 ve
= SCM_VELTS (result
);
962 ve
[0] = scm_ulong2num ((unsigned long) fam
);
963 ve
[1] = scm_makfromstr (nad
->sun_path
,
964 (scm_sizet
) strlen (nad
->sun_path
), 0);
969 scm_misc_error (proc
, "Unrecognised address family: ~A",
970 SCM_LIST1 (SCM_MAKINUM (fam
)));
975 /* calculate the size of a buffer large enough to hold any supported
976 sockaddr type. if the buffer isn't large enough, certain system
977 calls will return a truncated address. */
979 #if defined (HAVE_UNIX_DOMAIN_SOCKETS)
980 #define MAX_SIZE_UN sizeof (struct sockaddr_un)
982 #define MAX_SIZE_UN 0
985 #if defined (AF_INET6)
986 #define MAX_SIZE_IN6 sizeof (struct sockaddr_in6)
988 #define MAX_SIZE_IN6 0
991 #define MAX_ADDR_SIZE max (max (sizeof (struct sockaddr_in), MAX_SIZE_IN6),\
994 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
996 "Accept a connection on a bound, listening socket.\n"
998 "are no pending connections in the queue, wait until\n"
999 "one is available unless the non-blocking option has been\n"
1000 "set on the socket.\n\n"
1001 "The return value is a\n"
1002 "pair in which the @emph{car} is a new socket port for the\n"
1004 "the @emph{cdr} is an object with address information about the\n"
1005 "client which initiated the connection.\n\n"
1006 "@var{sock} does not become part of the\n"
1007 "connection and will continue to accept new requests.")
1008 #define FUNC_NAME s_scm_accept
1014 int addr_size
= MAX_ADDR_SIZE
;
1015 char max_addr
[MAX_ADDR_SIZE
];
1016 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1018 sock
= SCM_COERCE_OUTPORT (sock
);
1019 SCM_VALIDATE_OPFPORT (1, sock
);
1020 fd
= SCM_FPORT_FDES (sock
);
1021 newfd
= accept (fd
, addr
, &addr_size
);
1024 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
1025 address
= scm_addr_vector (addr
, FUNC_NAME
);
1026 return scm_cons (newsock
, address
);
1030 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
1032 "Return the address of @var{sock}, in the same form as the\n"
1033 "object returned by @code{accept}. On many systems the address\n"
1034 "of a socket in the @code{AF_FILE} namespace cannot be read.")
1035 #define FUNC_NAME s_scm_getsockname
1038 int addr_size
= MAX_ADDR_SIZE
;
1039 char max_addr
[MAX_ADDR_SIZE
];
1040 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1042 sock
= SCM_COERCE_OUTPORT (sock
);
1043 SCM_VALIDATE_OPFPORT (1,sock
);
1044 fd
= SCM_FPORT_FDES (sock
);
1045 if (getsockname (fd
, addr
, &addr_size
) == -1)
1047 return scm_addr_vector (addr
, FUNC_NAME
);
1051 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
1053 "Return the address that @var{sock}\n"
1054 "is connected to, in the same form as the object returned by\n"
1055 "@code{accept}. On many systems the address of a socket in the\n"
1056 "@code{AF_FILE} namespace cannot be read.")
1057 #define FUNC_NAME s_scm_getpeername
1060 int addr_size
= MAX_ADDR_SIZE
;
1061 char max_addr
[MAX_ADDR_SIZE
];
1062 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1064 sock
= SCM_COERCE_OUTPORT (sock
);
1065 SCM_VALIDATE_OPFPORT (1,sock
);
1066 fd
= SCM_FPORT_FDES (sock
);
1067 if (getpeername (fd
, addr
, &addr_size
) == -1)
1069 return scm_addr_vector (addr
, FUNC_NAME
);
1073 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
1074 (SCM sock
, SCM buf
, SCM flags
),
1075 "Receive data from a socket port.\n"
1076 "@var{sock} must already\n"
1077 "be bound to the address from which data is to be received.\n"
1078 "@var{buf} is a string into which\n"
1079 "the data will be written. The size of @var{buf} limits\n"
1081 "data which can be received: in the case of packet\n"
1082 "protocols, if a packet larger than this limit is encountered\n"
1084 "will be irrevocably lost.\n\n"
1085 "The optional @var{flags} argument is a value or\n"
1086 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1087 "The value returned is the number of bytes read from the\n"
1089 "Note that the data is read directly from the socket file\n"
1091 "any unread buffered port data is ignored.")
1092 #define FUNC_NAME s_scm_recv
1098 SCM_VALIDATE_OPFPORT (1,sock
);
1099 SCM_VALIDATE_STRING (2,buf
);
1100 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
1101 fd
= SCM_FPORT_FDES (sock
);
1103 SCM_SYSCALL (rv
= recv (fd
, SCM_STRING_CHARS (buf
), SCM_STRING_LENGTH (buf
), flg
));
1107 return SCM_MAKINUM (rv
);
1111 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
1112 (SCM sock
, SCM message
, SCM flags
),
1113 "Transmit the string @var{message} on a socket port @var{sock}.\n"
1114 "@var{sock} must already be bound to a destination address. The\n"
1115 "value returned is the number of bytes transmitted --\n"
1116 "it's possible for\n"
1117 "this to be less than the length of @var{message}\n"
1118 "if the socket is\n"
1119 "set to be non-blocking. The optional @var{flags} argument\n"
1121 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1122 "Note that the data is written directly to the socket\n"
1123 "file descriptor:\n"
1124 "any unflushed buffered port data is ignored.")
1125 #define FUNC_NAME s_scm_send
1131 sock
= SCM_COERCE_OUTPORT (sock
);
1132 SCM_VALIDATE_OPFPORT (1,sock
);
1133 SCM_VALIDATE_STRING (2, message
);
1134 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
1135 fd
= SCM_FPORT_FDES (sock
);
1137 SCM_SYSCALL (rv
= send (fd
, SCM_STRING_CHARS (message
), SCM_STRING_LENGTH (message
), flg
));
1140 return SCM_MAKINUM (rv
);
1144 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
1145 (SCM sock
, SCM str
, SCM flags
, SCM start
, SCM end
),
1146 "Return data from the socket port @var{sock} and also\n"
1147 "information about where the data was received from.\n"
1148 "@var{sock} must already be bound to the address from which\n"
1149 "data is to be received. @code{str}, is a string into which the\n"
1150 "data will be written. The size of @var{str} limits the amount\n"
1151 "of data which can be received: in the case of packet protocols,\n"
1152 "if a packet larger than this limit is encountered then some\n"
1153 "data will be irrevocably lost.\n\n"
1154 "The optional @var{flags} argument is a value or bitwise OR of\n"
1155 "@code{MSG_OOB}, @code{MSG_PEEK}, @code{MSG_DONTROUTE} etc.\n\n"
1156 "The value returned is a pair: the @emph{car} is the number of\n"
1157 "bytes read from the socket and the @emph{cdr} an address object\n"
1158 "in the same form as returned by @code{accept}. The address\n"
1159 "will given as @code{#f} if not available, as is usually the\n"
1160 "case for stream sockets.\n\n"
1161 "The @var{start} and @var{end} arguments specify a substring of\n"
1162 "@var{str} to which the data should be written.\n\n"
1163 "Note that the data is read directly from the socket file\n"
1164 "descriptor: any unread buffered port data is ignored.")
1165 #define FUNC_NAME s_scm_recvfrom
1174 int addr_size
= MAX_ADDR_SIZE
;
1175 char max_addr
[MAX_ADDR_SIZE
];
1176 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1178 SCM_VALIDATE_OPFPORT (1,sock
);
1179 fd
= SCM_FPORT_FDES (sock
);
1180 SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, str
, buf
, 4, start
, offset
,
1182 if (SCM_UNBNDP (flags
))
1185 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
1187 /* recvfrom will not necessarily return an address. usually nothing
1188 is returned for stream sockets. */
1189 addr
->sa_family
= AF_UNSPEC
;
1190 SCM_SYSCALL (rv
= recvfrom (fd
, buf
+ offset
,
1195 if (addr
->sa_family
!= AF_UNSPEC
)
1196 address
= scm_addr_vector (addr
, FUNC_NAME
);
1198 address
= SCM_BOOL_F
;
1200 return scm_cons (SCM_MAKINUM (rv
), address
);
1204 SCM_DEFINE (scm_sendto
, "sendto", 4, 0, 1,
1205 (SCM sock
, SCM message
, SCM fam
, SCM address
, SCM args_and_flags
),
1206 "Transmit the string @var{message} on the socket port\n"
1208 "destination address is specified using the @var{fam},\n"
1209 "@var{address} and\n"
1210 "@var{args_and_flags} arguments, in a similar way to the\n"
1211 "@code{connect} procedure. @var{args_and_flags} contains\n"
1212 "the usual connection arguments optionally followed by\n"
1213 "a flags argument, which is a value or\n"
1214 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1215 "The value returned is the number of bytes transmitted --\n"
1216 "it's possible for\n"
1217 "this to be less than the length of @var{message} if the\n"
1219 "set to be non-blocking.\n"
1220 "Note that the data is written directly to the socket\n"
1221 "file descriptor:\n"
1222 "any unflushed buffered port data is ignored.")
1223 #define FUNC_NAME s_scm_sendto
1228 struct sockaddr
*soka
;
1231 sock
= SCM_COERCE_OUTPORT (sock
);
1232 SCM_VALIDATE_FPORT (1,sock
);
1233 SCM_VALIDATE_STRING (2, message
);
1234 SCM_VALIDATE_INUM (3,fam
);
1235 fd
= SCM_FPORT_FDES (sock
);
1236 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args_and_flags
, 4,
1238 if (SCM_NULLP (args_and_flags
))
1242 SCM_VALIDATE_CONS (5,args_and_flags
);
1243 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
1245 SCM_SYSCALL (rv
= sendto (fd
, SCM_STRING_CHARS (message
),
1246 SCM_STRING_LENGTH (message
),
1250 int save_errno
= errno
;
1256 return SCM_MAKINUM (rv
);
1265 /* protocol families. */
1267 scm_sysintern ("AF_UNSPEC", SCM_MAKINUM (AF_UNSPEC
));
1270 scm_sysintern ("AF_UNIX", SCM_MAKINUM (AF_UNIX
));
1273 scm_sysintern ("AF_INET", SCM_MAKINUM (AF_INET
));
1276 scm_sysintern ("AF_INET6", SCM_MAKINUM (AF_INET6
));
1280 scm_sysintern ("PF_UNSPEC", SCM_MAKINUM (PF_UNSPEC
));
1283 scm_sysintern ("PF_UNIX", SCM_MAKINUM (PF_UNIX
));
1286 scm_sysintern ("PF_INET", SCM_MAKINUM (PF_INET
));
1289 scm_sysintern ("PF_INET6", SCM_MAKINUM (PF_INET6
));
1292 /* standard addresses. */
1294 scm_sysintern ("INADDR_ANY", scm_ulong2num (INADDR_ANY
));
1296 #ifdef INADDR_BROADCAST
1297 scm_sysintern ("INADDR_BROADCAST", scm_ulong2num (INADDR_BROADCAST
));
1300 scm_sysintern ("INADDR_NONE", scm_ulong2num (INADDR_NONE
));
1302 #ifdef INADDR_LOOPBACK
1303 scm_sysintern ("INADDR_LOOPBACK", scm_ulong2num (INADDR_LOOPBACK
));
1308 scm_sysintern ("SOCK_STREAM", SCM_MAKINUM (SOCK_STREAM
));
1311 scm_sysintern ("SOCK_DGRAM", SCM_MAKINUM (SOCK_DGRAM
));
1314 scm_sysintern ("SOCK_RAW", SCM_MAKINUM (SOCK_RAW
));
1317 /* setsockopt level. */
1319 scm_sysintern ("SOL_SOCKET", SCM_MAKINUM (SOL_SOCKET
));
1322 scm_sysintern ("SOL_IP", SCM_MAKINUM (SOL_IP
));
1325 scm_sysintern ("SOL_TCP", SCM_MAKINUM (SOL_TCP
));
1328 scm_sysintern ("SOL_UDP", SCM_MAKINUM (SOL_UDP
));
1331 /* setsockopt names. */
1333 scm_sysintern ("SO_DEBUG", SCM_MAKINUM (SO_DEBUG
));
1336 scm_sysintern ("SO_REUSEADDR", SCM_MAKINUM (SO_REUSEADDR
));
1339 scm_sysintern ("SO_STYLE", SCM_MAKINUM (SO_STYLE
));
1342 scm_sysintern ("SO_TYPE", SCM_MAKINUM (SO_TYPE
));
1345 scm_sysintern ("SO_ERROR", SCM_MAKINUM (SO_ERROR
));
1348 scm_sysintern ("SO_DONTROUTE", SCM_MAKINUM (SO_DONTROUTE
));
1351 scm_sysintern ("SO_BROADCAST", SCM_MAKINUM (SO_BROADCAST
));
1354 scm_sysintern ("SO_SNDBUF", SCM_MAKINUM (SO_SNDBUF
));
1357 scm_sysintern ("SO_RCVBUF", SCM_MAKINUM (SO_RCVBUF
));
1360 scm_sysintern ("SO_KEEPALIVE", SCM_MAKINUM (SO_KEEPALIVE
));
1363 scm_sysintern ("SO_OOBINLINE", SCM_MAKINUM (SO_OOBINLINE
));
1366 scm_sysintern ("SO_NO_CHECK", SCM_MAKINUM (SO_NO_CHECK
));
1369 scm_sysintern ("SO_PRIORITY", SCM_MAKINUM (SO_PRIORITY
));
1372 scm_sysintern ("SO_LINGER", SCM_MAKINUM (SO_LINGER
));
1375 /* recv/send options. */
1377 scm_sysintern ("MSG_OOB", SCM_MAKINUM (MSG_OOB
));
1380 scm_sysintern ("MSG_PEEK", SCM_MAKINUM (MSG_PEEK
));
1382 #ifdef MSG_DONTROUTE
1383 scm_sysintern ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE
));
1386 scm_add_feature ("socket");
1388 #ifndef SCM_MAGIC_SNARFER
1389 #include "libguile/socket.x"