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 #ifdef HAVE_WINSOCK2_H
69 #include <sys/socket.h>
70 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
73 #include <netinet/in.h>
75 #include <arpa/inet.h>
78 #if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
79 #define SUN_LEN(ptr) ((size_t) (((struct sockaddr_un *) 0)->sun_path) \
80 + strlen ((ptr)->sun_path))
83 #if !defined (HAVE_UINT32_T)
85 typedef unsigned int uint32_t;
86 #elif SIZEOF_LONG == 4
87 typedef unsigned long uint32_t;
89 #error can not define uint32_t
93 /* we are not currently using socklen_t. it's not defined on all systems,
94 so would need to be checked by configure. in the meantime, plain
95 int is the best alternative. */
99 SCM_DEFINE (scm_htons
, "htons", 1, 0, 0,
101 "Convert a 16 bit quantity from host to network byte ordering.\n"
102 "@var{value} is packed into 2 bytes, which are then converted\n"
103 "and returned as a new integer.")
104 #define FUNC_NAME s_scm_htons
108 SCM_VALIDATE_INUM_COPY (1, value
, c_in
);
109 if (c_in
!= SCM_INUM (value
))
110 SCM_OUT_OF_RANGE (1, value
);
112 return SCM_MAKINUM (htons (c_in
));
116 SCM_DEFINE (scm_ntohs
, "ntohs", 1, 0, 0,
118 "Convert a 16 bit quantity from network to host byte ordering.\n"
119 "@var{value} is packed into 2 bytes, which are then converted\n"
120 "and returned as a new integer.")
121 #define FUNC_NAME s_scm_ntohs
125 SCM_VALIDATE_INUM_COPY (1, value
, c_in
);
126 if (c_in
!= SCM_INUM (value
))
127 SCM_OUT_OF_RANGE (1, value
);
129 return SCM_MAKINUM (ntohs (c_in
));
133 SCM_DEFINE (scm_htonl
, "htonl", 1, 0, 0,
135 "Convert a 32 bit quantity from host to network byte ordering.\n"
136 "@var{value} is packed into 4 bytes, which are then converted\n"
137 "and returned as a new integer.")
138 #define FUNC_NAME s_scm_htonl
140 uint32_t c_in
= SCM_NUM2ULONG (1, value
);
142 return scm_ulong2num (htonl (c_in
));
146 SCM_DEFINE (scm_ntohl
, "ntohl", 1, 0, 0,
148 "Convert a 32 bit quantity from network to host byte ordering.\n"
149 "@var{value} is packed into 4 bytes, which are then converted\n"
150 "and returned as a new integer.")
151 #define FUNC_NAME s_scm_ntohl
153 uint32_t c_in
= SCM_NUM2ULONG (1, value
);
155 return scm_ulong2num (ntohl (c_in
));
159 #ifndef HAVE_INET_ATON
160 /* for our definition in inet_aton.c, not usually needed. */
161 extern int inet_aton ();
164 SCM_DEFINE (scm_inet_aton
, "inet-aton", 1, 0, 0,
166 "Convert an IPv4 Internet address from printable string\n"
167 "(dotted decimal notation) to an integer. E.g.,\n\n"
169 "(inet-aton \"127.0.0.1\") @result{} 2130706433\n"
171 #define FUNC_NAME s_scm_inet_aton
175 SCM_VALIDATE_STRING (1, address
);
176 SCM_STRING_COERCE_0TERMINATION_X (address
);
177 if (inet_aton (SCM_STRING_CHARS (address
), &soka
) == 0)
178 SCM_MISC_ERROR ("bad address", SCM_EOL
);
179 return scm_ulong2num (ntohl (soka
.s_addr
));
184 SCM_DEFINE (scm_inet_ntoa
, "inet-ntoa", 1, 0, 0,
186 "Convert an IPv4 Internet address to a printable\n"
187 "(dotted decimal notation) string. E.g.,\n\n"
189 "(inet-ntoa 2130706433) @result{} \"127.0.0.1\"\n"
191 #define FUNC_NAME s_scm_inet_ntoa
196 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, inetid
));
197 s
= inet_ntoa (addr
);
198 answer
= scm_mem2string (s
, strlen (s
));
203 #ifdef HAVE_INET_NETOF
204 SCM_DEFINE (scm_inet_netof
, "inet-netof", 1, 0, 0,
206 "Return the network number part of the given IPv4\n"
207 "Internet address. E.g.,\n\n"
209 "(inet-netof 2130706433) @result{} 127\n"
211 #define FUNC_NAME s_scm_inet_netof
214 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
215 return scm_ulong2num ((unsigned long) inet_netof (addr
));
220 #ifdef HAVE_INET_LNAOF
221 SCM_DEFINE (scm_lnaof
, "inet-lnaof", 1, 0, 0,
223 "Return the local-address-with-network part of the given\n"
224 "IPv4 Internet address, using the obsolete class A/B/C system.\n"
227 "(inet-lnaof 2130706433) @result{} 1\n"
229 #define FUNC_NAME s_scm_lnaof
232 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
233 return scm_ulong2num ((unsigned long) inet_lnaof (addr
));
238 #ifdef HAVE_INET_MAKEADDR
239 SCM_DEFINE (scm_inet_makeaddr
, "inet-makeaddr", 2, 0, 0,
241 "Make an IPv4 Internet address by combining the network number\n"
242 "@var{net} with the local-address-within-network number\n"
243 "@var{lna}. E.g.,\n\n"
245 "(inet-makeaddr 127 1) @result{} 2130706433\n"
247 #define FUNC_NAME s_scm_inet_makeaddr
250 unsigned long netnum
;
251 unsigned long lnanum
;
253 netnum
= SCM_NUM2ULONG (1, net
);
254 lnanum
= SCM_NUM2ULONG (2, lna
);
255 addr
= inet_makeaddr (netnum
, lnanum
);
256 return scm_ulong2num (ntohl (addr
.s_addr
));
263 /* flip a 128 bit IPv6 address between host and network order. */
264 #ifdef WORDS_BIGENDIAN
265 #define FLIP_NET_HOST_128(addr)
267 #define FLIP_NET_HOST_128(addr)\
271 for (i = 0; i < 8; i++)\
275 (addr)[i] = (addr)[15 - i];\
281 /* convert a 128 bit IPv6 address in network order to a host ordered
283 static SCM
ipv6_net_to_num (const char *src
)
285 int big_digits
= 128 / SCM_BITSPERDIG
;
286 const int bytes_per_dig
= SCM_BITSPERDIG
/ 8;
291 memcpy (addr
, src
, 16);
292 /* get rid of leading zeros. */
293 while (big_digits
> 0)
297 memcpy (&test
, ptr
, bytes_per_dig
);
300 ptr
+= bytes_per_dig
;
303 FLIP_NET_HOST_128 (addr
);
304 if (big_digits
* bytes_per_dig
<= sizeof (unsigned long))
306 /* this is just so that we use INUM where possible. */
307 unsigned long l_addr
;
309 memcpy (&l_addr
, addr
, sizeof (unsigned long));
310 result
= scm_ulong2num (l_addr
);
314 result
= scm_i_mkbig (big_digits
, 0);
315 memcpy (SCM_BDIGITS (result
), addr
, big_digits
* bytes_per_dig
);
320 /* convert a host ordered SCM integer to a 128 bit IPv6 address in
322 static void ipv6_num_to_net (SCM src
, char *dst
)
326 uint32_t addr
= htonl (SCM_INUM (src
));
329 memcpy (dst
+ 12, &addr
, 4);
334 memcpy (dst
, SCM_BDIGITS (src
),
335 SCM_NUMDIGS (src
) * (SCM_BITSPERDIG
/ 8));
336 FLIP_NET_HOST_128 (dst
);
340 /* check that an SCM variable contains an IPv6 integer address. */
341 #define VALIDATE_INET6(which_arg, address)\
342 if (SCM_INUMP (address))\
343 SCM_ASSERT_RANGE (which_arg, address, SCM_INUM (address) >= 0);\
346 SCM_VALIDATE_BIGINT (which_arg, address);\
347 SCM_ASSERT_RANGE (which_arg, address,\
348 !SCM_BIGSIGN (address)\
350 * SCM_NUMDIGS (address) <= 128));\
353 #ifdef HAVE_INET_PTON
354 SCM_DEFINE (scm_inet_pton
, "inet-pton", 2, 0, 0,
355 (SCM family
, SCM address
),
356 "Convert a string containing a printable network address to\n"
357 "an integer address. Note that unlike the C version of this\n"
359 "the result is an integer with normal host byte ordering.\n"
360 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
362 "(inet-pton AF_INET \"127.0.0.1\") @result{} 2130706433\n"
363 "(inet-pton AF_INET6 \"::1\") @result{} 1\n"
365 #define FUNC_NAME s_scm_inet_pton
372 SCM_VALIDATE_INUM_COPY (1, family
, af
);
373 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
374 SCM_VALIDATE_STRING_COPY (2, address
, src
);
375 rv
= inet_pton (af
, src
, dst
);
379 SCM_MISC_ERROR ("Bad address", SCM_EOL
);
381 return scm_ulong2num (ntohl (*(uint32_t *) dst
));
383 return ipv6_net_to_num ((char *) dst
);
388 #ifdef HAVE_INET_NTOP
389 SCM_DEFINE (scm_inet_ntop
, "inet-ntop", 2, 0, 0,
390 (SCM family
, SCM address
),
391 "Convert a network address into a printable string.\n"
392 "Note that unlike the C version of this function,\n"
393 "the input is an integer with normal host byte ordering.\n"
394 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
396 "(inet-ntop AF_INET 2130706433) @result{} \"127.0.0.1\"\n"
397 "(inet-ntop AF_INET6 (- (expt 2 128) 1)) @result{}\n"
398 "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\n"
400 #define FUNC_NAME s_scm_inet_ntop
403 #ifdef INET6_ADDRSTRLEN
404 char dst
[INET6_ADDRSTRLEN
];
410 SCM_VALIDATE_INUM_COPY (1, family
, af
);
411 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
413 *(uint32_t *) addr6
= htonl (SCM_NUM2ULONG (2, address
));
416 VALIDATE_INET6 (2, address
);
417 ipv6_num_to_net (address
, addr6
);
419 if (inet_ntop (af
, &addr6
, dst
, sizeof dst
) == NULL
)
421 return scm_makfrom0str (dst
);
426 #endif /* HAVE_IPV6 */
428 SCM_SYMBOL (sym_socket
, "socket");
430 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
432 SCM_DEFINE (scm_socket
, "socket", 3, 0, 0,
433 (SCM family
, SCM style
, SCM proto
),
434 "Return a new socket port of the type specified by @var{family},\n"
435 "@var{style} and @var{proto}. All three parameters are\n"
436 "integers. Supported values for @var{family} are\n"
437 "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
438 "Typical values for @var{style} are @code{SOCK_STREAM},\n"
439 "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
440 "@var{proto} can be obtained from a protocol name using\n"
441 "@code{getprotobyname}. A value of zero specifies the default\n"
442 "protocol, which is usually right.\n\n"
443 "A single socket port cannot by used for communication until it\n"
444 "has been connected to another socket.")
445 #define FUNC_NAME s_scm_socket
449 SCM_VALIDATE_INUM (1, family
);
450 SCM_VALIDATE_INUM (2, style
);
451 SCM_VALIDATE_INUM (3, proto
);
452 fd
= socket (SCM_INUM (family
), SCM_INUM (style
), SCM_INUM (proto
));
455 return SCM_SOCK_FD_TO_PORT (fd
);
459 #ifdef HAVE_SOCKETPAIR
460 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
461 (SCM family
, SCM style
, SCM proto
),
462 "Return a pair of connected (but unnamed) socket ports of the\n"
463 "type specified by @var{family}, @var{style} and @var{proto}.\n"
464 "Many systems support only socket pairs of the @code{AF_UNIX}\n"
465 "family. Zero is likely to be the only meaningful value for\n"
467 #define FUNC_NAME s_scm_socketpair
472 SCM_VALIDATE_INUM (1,family
);
473 SCM_VALIDATE_INUM (2,style
);
474 SCM_VALIDATE_INUM (3,proto
);
476 fam
= SCM_INUM (family
);
478 if (socketpair (fam
, SCM_INUM (style
), SCM_INUM (proto
), fd
) == -1)
481 return scm_cons (SCM_SOCK_FD_TO_PORT (fd
[0]), SCM_SOCK_FD_TO_PORT (fd
[1]));
486 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
487 (SCM sock
, SCM level
, SCM optname
),
488 "Return the value of a particular socket option for the socket\n"
489 "port @var{sock}. @var{level} is an integer code for type of\n"
490 "option being requested, e.g., @code{SOL_SOCKET} for\n"
491 "socket-level options. @var{optname} is an integer code for the\n"
492 "option required and should be specified using one of the\n"
493 "symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n\n"
494 "The returned value is typically an integer but @code{SO_LINGER}\n"
495 "returns a pair of integers.")
496 #define FUNC_NAME s_scm_getsockopt
499 /* size of optval is the largest supported option. */
500 #ifdef HAVE_STRUCT_LINGER
501 char optval
[sizeof (struct linger
)];
502 int optlen
= sizeof (struct linger
);
504 char optval
[sizeof (size_t)];
505 int optlen
= sizeof (size_t);
510 sock
= SCM_COERCE_OUTPORT (sock
);
511 SCM_VALIDATE_OPFPORT (1, sock
);
512 SCM_VALIDATE_INUM_COPY (2, level
, ilevel
);
513 SCM_VALIDATE_INUM_COPY (3, optname
, ioptname
);
515 fd
= SCM_FPORT_FDES (sock
);
516 if (getsockopt (fd
, ilevel
, ioptname
, (void *) optval
, &optlen
) == -1)
519 if (ilevel
== SOL_SOCKET
)
522 if (ioptname
== SO_LINGER
)
524 #ifdef HAVE_STRUCT_LINGER
525 struct linger
*ling
= (struct linger
*) optval
;
527 return scm_cons (scm_long2num (ling
->l_onoff
),
528 scm_long2num (ling
->l_linger
));
530 return scm_cons (scm_long2num (*(int *) optval
),
538 || ioptname
== SO_SNDBUF
541 || ioptname
== SO_RCVBUF
545 return scm_long2num (*(size_t *) optval
);
548 return scm_long2num (*(int *) optval
);
552 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
553 (SCM sock
, SCM level
, SCM optname
, SCM value
),
554 "Set the value of a particular socket option for the socket\n"
555 "port @var{sock}. @var{level} is an integer code for type of option\n"
556 "being set, e.g., @code{SOL_SOCKET} for socket-level options.\n"
557 "@var{optname} is an\n"
558 "integer code for the option to set and should be specified using one of\n"
559 "the symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n"
560 "@var{value} is the value to which the option should be set. For\n"
561 "most options this must be an integer, but for @code{SO_LINGER} it must\n"
563 "The return value is unspecified.")
564 #define FUNC_NAME s_scm_setsockopt
568 /* size of optval is the largest supported option. */
569 #ifdef HAVE_STRUCT_LINGER
570 char optval
[sizeof (struct linger
)];
572 char optval
[sizeof (size_t)];
574 int ilevel
, ioptname
;
576 sock
= SCM_COERCE_OUTPORT (sock
);
578 SCM_VALIDATE_OPFPORT (1, sock
);
579 SCM_VALIDATE_INUM_COPY (2, level
, ilevel
);
580 SCM_VALIDATE_INUM_COPY (3, optname
, ioptname
);
582 fd
= SCM_FPORT_FDES (sock
);
584 if (ilevel
== SOL_SOCKET
)
587 if (ioptname
== SO_LINGER
)
589 #ifdef HAVE_STRUCT_LINGER
593 SCM_ASSERT (SCM_CONSP (value
), value
, SCM_ARG4
, FUNC_NAME
);
594 lv
= SCM_NUM2LONG (4, SCM_CAR (value
));
595 ling
.l_onoff
= (int) lv
;
596 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
.l_onoff
== lv
);
597 lv
= SCM_NUM2LONG (4, SCM_CDR (value
));
598 ling
.l_linger
= (int) lv
;
599 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
.l_linger
== lv
);
600 optlen
= (int) sizeof (struct linger
);
601 memcpy (optval
, (void *) &ling
, optlen
);
606 SCM_ASSERT (SCM_CONSP (value
), value
, SCM_ARG4
, FUNC_NAME
);
607 /* timeout is ignored, but may as well validate it. */
608 lv
= SCM_NUM2LONG (4, SCM_CDR (value
));
610 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
== lv
);
611 lv
= SCM_NUM2LONG (4, SCM_CAR (value
));
613 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
== lv
);
614 optlen
= (int) sizeof (int);
615 (*(int *) optval
) = ling
;
622 || ioptname
== SO_SNDBUF
625 || ioptname
== SO_RCVBUF
629 long lv
= SCM_NUM2LONG (4, value
);
631 optlen
= (int) sizeof (size_t);
632 (*(size_t *) optval
) = (size_t) lv
;
637 /* Most options take an int. */
638 long lv
= SCM_NUM2LONG (4, value
);
641 SCM_ASSERT_RANGE (SCM_ARG4
, value
, val
== lv
);
642 optlen
= (int) sizeof (int);
643 (*(int *) optval
) = val
;
645 if (setsockopt (fd
, ilevel
, ioptname
, (void *) optval
, optlen
) == -1)
647 return SCM_UNSPECIFIED
;
651 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
653 "Sockets can be closed simply by using @code{close-port}. The\n"
654 "@code{shutdown} procedure allows reception or tranmission on a\n"
655 "connection to be shut down individually, according to the parameter\n"
659 "Stop receiving data for this socket. If further data arrives, reject it.\n"
661 "Stop trying to transmit data from this socket. Discard any\n"
662 "data waiting to be sent. Stop looking for acknowledgement of\n"
663 "data already sent; don't retransmit it if it is lost.\n"
665 "Stop both reception and transmission.\n"
667 "The return value is unspecified.")
668 #define FUNC_NAME s_scm_shutdown
671 sock
= SCM_COERCE_OUTPORT (sock
);
672 SCM_VALIDATE_OPFPORT (1,sock
);
673 SCM_VALIDATE_INUM (2,how
);
674 SCM_ASSERT_RANGE(2,how
,0 <= SCM_INUM (how
) && 2 >= SCM_INUM (how
));
675 fd
= SCM_FPORT_FDES (sock
);
676 if (shutdown (fd
, SCM_INUM (how
)) == -1)
678 return SCM_UNSPECIFIED
;
682 /* convert fam/address/args into a sockaddr of the appropriate type.
683 args is modified by removing the arguments actually used.
684 which_arg and proc are used when reporting errors:
685 which_arg is the position of address in the original argument list.
686 proc is the name of the original procedure.
687 size returns the size of the structure allocated. */
689 static struct sockaddr
*
690 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
691 const char *proc
, int *size
)
692 #define FUNC_NAME proc
698 struct sockaddr_in
*soka
;
702 SCM_VALIDATE_ULONG_COPY (which_arg
, address
, addr
);
703 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
704 SCM_VALIDATE_INUM_COPY (which_arg
+ 1, SCM_CAR (*args
), port
);
705 *args
= SCM_CDR (*args
);
706 soka
= (struct sockaddr_in
*) malloc (sizeof (struct sockaddr_in
));
708 scm_memory_error (proc
);
709 /* 4.4BSD-style interface includes sin_len member and defines SIN_LEN,
712 soka
->sin_len
= sizeof (struct sockaddr_in
);
714 soka
->sin_family
= AF_INET
;
715 soka
->sin_addr
.s_addr
= htonl (addr
);
716 soka
->sin_port
= htons (port
);
717 *size
= sizeof (struct sockaddr_in
);
718 return (struct sockaddr
*) soka
;
725 struct sockaddr_in6
*soka
;
726 unsigned long flowinfo
= 0;
727 unsigned long scope_id
= 0;
729 VALIDATE_INET6 (which_arg
, address
);
730 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
731 SCM_VALIDATE_INUM_COPY (which_arg
+ 1, SCM_CAR (*args
), port
);
732 *args
= SCM_CDR (*args
);
733 if (SCM_CONSP (*args
))
735 SCM_VALIDATE_ULONG_COPY (which_arg
+ 2, SCM_CAR (*args
), flowinfo
);
736 *args
= SCM_CDR (*args
);
737 if (SCM_CONSP (*args
))
739 SCM_VALIDATE_ULONG_COPY (which_arg
+ 3, SCM_CAR (*args
),
741 *args
= SCM_CDR (*args
);
744 soka
= (struct sockaddr_in6
*) malloc (sizeof (struct sockaddr_in6
));
746 scm_memory_error (proc
);
748 soka
->sin6_len
= sizeof (struct sockaddr_in6
);
750 soka
->sin6_family
= AF_INET6
;
751 ipv6_num_to_net (address
, soka
->sin6_addr
.s6_addr
);
752 soka
->sin6_port
= htons (port
);
753 soka
->sin6_flowinfo
= flowinfo
;
754 #ifdef HAVE_SIN6_SCOPE_ID
755 soka
->sin6_scope_id
= scope_id
;
757 *size
= sizeof (struct sockaddr_in6
);
758 return (struct sockaddr
*) soka
;
761 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
764 struct sockaddr_un
*soka
;
767 SCM_ASSERT (SCM_STRINGP (address
), address
, which_arg
, proc
);
768 /* the static buffer size in sockaddr_un seems to be arbitrary
769 and not necessarily a hard limit. e.g., the glibc manual
770 suggests it may be possible to declare it size 0. let's
771 ignore it. if the O/S doesn't like the size it will cause
772 connect/bind etc., to fail. sun_path is always the last
773 member of the structure. */
774 addr_size
= sizeof (struct sockaddr_un
)
775 + max (0, SCM_STRING_LENGTH (address
) + 1 - (sizeof soka
->sun_path
));
776 soka
= (struct sockaddr_un
*) malloc (addr_size
);
778 scm_memory_error (proc
);
779 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
780 soka
->sun_family
= AF_UNIX
;
781 memcpy (soka
->sun_path
, SCM_STRING_CHARS (address
),
782 SCM_STRING_LENGTH (address
));
783 *size
= SUN_LEN (soka
);
784 return (struct sockaddr
*) soka
;
788 scm_out_of_range (proc
, SCM_MAKINUM (fam
));
793 SCM_DEFINE (scm_connect
, "connect", 3, 0, 1,
794 (SCM sock
, SCM fam
, SCM address
, SCM args
),
795 "Initiate a connection from a socket using a specified address\n"
796 "family to the address\n"
797 "specified by @var{address} and possibly @var{args}.\n"
798 "The format required for @var{address}\n"
799 "and @var{args} depends on the family of the socket.\n\n"
800 "For a socket of family @code{AF_UNIX},\n"
801 "only @var{address} is specified and must be a string with the\n"
802 "filename where the socket is to be created.\n\n"
803 "For a socket of family @code{AF_INET},\n"
804 "@var{address} must be an integer IPv4 host address and\n"
805 "@var{args} must be a single integer port number.\n\n"
806 "For a socket of family @code{AF_INET6},\n"
807 "@var{address} must be an integer IPv6 host address and\n"
808 "@var{args} may be up to three integers:\n"
809 "port [flowinfo] [scope_id],\n"
810 "where flowinfo and scope_id default to zero.\n\n"
811 "The return value is unspecified.")
812 #define FUNC_NAME s_scm_connect
815 struct sockaddr
*soka
;
818 sock
= SCM_COERCE_OUTPORT (sock
);
819 SCM_VALIDATE_OPFPORT (1,sock
);
820 SCM_VALIDATE_INUM (2,fam
);
821 fd
= SCM_FPORT_FDES (sock
);
822 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
824 if (connect (fd
, soka
, size
) == -1)
826 int save_errno
= errno
;
833 return SCM_UNSPECIFIED
;
837 SCM_DEFINE (scm_bind
, "bind", 3, 0, 1,
838 (SCM sock
, SCM fam
, SCM address
, SCM args
),
839 "Assign an address to the socket port @var{sock}.\n"
840 "Generally this only needs to be done for server sockets,\n"
841 "so they know where to look for incoming connections. A socket\n"
842 "without an address will be assigned one automatically when it\n"
843 "starts communicating.\n\n"
844 "The format of @var{address} and @var{args} depends\n"
845 "on the family of the socket.\n\n"
846 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
847 "is specified and must be a string with the filename where\n"
848 "the socket is to be created.\n\n"
849 "For a socket of family @code{AF_INET}, @var{address}\n"
850 "must be an integer IPv4 address and @var{args}\n"
851 "must be a single integer port number.\n\n"
852 "The values of the following variables can also be used for\n"
854 "@defvar INADDR_ANY\n"
855 "Allow connections from any address.\n"
857 "@defvar INADDR_LOOPBACK\n"
858 "The address of the local host using the loopback device.\n"
860 "@defvar INADDR_BROADCAST\n"
861 "The broadcast address on the local network.\n"
863 "@defvar INADDR_NONE\n"
866 "For a socket of family @code{AF_INET6}, @var{address}\n"
867 "must be an integer IPv6 address and @var{args}\n"
868 "may be up to three integers:\n"
869 "port [flowinfo] [scope_id],\n"
870 "where flowinfo and scope_id default to zero.\n\n"
871 "The return value is unspecified.")
872 #define FUNC_NAME s_scm_bind
874 struct sockaddr
*soka
;
878 sock
= SCM_COERCE_OUTPORT (sock
);
879 SCM_VALIDATE_OPFPORT (1, sock
);
880 SCM_VALIDATE_INUM (2, fam
);
881 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
883 fd
= SCM_FPORT_FDES (sock
);
884 if (bind (fd
, soka
, size
) == -1)
886 int save_errno
= errno
;
893 return SCM_UNSPECIFIED
;
897 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
898 (SCM sock
, SCM backlog
),
899 "Enable @var{sock} to accept connection\n"
900 "requests. @var{backlog} is an integer specifying\n"
901 "the maximum length of the queue for pending connections.\n"
902 "If the queue fills, new clients will fail to connect until\n"
903 "the server calls @code{accept} to accept a connection from\n"
905 "The return value is unspecified.")
906 #define FUNC_NAME s_scm_listen
909 sock
= SCM_COERCE_OUTPORT (sock
);
910 SCM_VALIDATE_OPFPORT (1,sock
);
911 SCM_VALIDATE_INUM (2,backlog
);
912 fd
= SCM_FPORT_FDES (sock
);
913 if (listen (fd
, SCM_INUM (backlog
)) == -1)
915 return SCM_UNSPECIFIED
;
919 /* Put the components of a sockaddr into a new SCM vector. */
921 scm_addr_vector (const struct sockaddr
*address
, const char *proc
)
923 short int fam
= address
->sa_family
;
931 const struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
933 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
934 ve
= SCM_VELTS (result
);
935 ve
[0] = scm_ulong2num ((unsigned long) fam
);
936 ve
[1] = scm_ulong2num (ntohl (nad
->sin_addr
.s_addr
));
937 ve
[2] = scm_ulong2num ((unsigned long) ntohs (nad
->sin_port
));
943 const struct sockaddr_in6
*nad
= (struct sockaddr_in6
*) address
;
945 result
= scm_c_make_vector (5, SCM_UNSPECIFIED
);
946 ve
= SCM_VELTS (result
);
947 ve
[0] = scm_ulong2num ((unsigned long) fam
);
948 ve
[1] = ipv6_net_to_num (nad
->sin6_addr
.s6_addr
);
949 ve
[2] = scm_ulong2num ((unsigned long) ntohs (nad
->sin6_port
));
950 ve
[3] = scm_ulong2num ((unsigned long) nad
->sin6_flowinfo
);
951 #ifdef HAVE_SIN6_SCOPE_ID
952 ve
[4] = scm_ulong2num ((unsigned long) nad
->sin6_scope_id
);
959 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
962 const struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
964 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
965 ve
= SCM_VELTS (result
);
966 ve
[0] = scm_ulong2num ((unsigned long) fam
);
967 ve
[1] = scm_mem2string (nad
->sun_path
, strlen (nad
->sun_path
));
972 scm_misc_error (proc
, "Unrecognised address family: ~A",
973 scm_list_1 (SCM_MAKINUM (fam
)));
978 /* calculate the size of a buffer large enough to hold any supported
979 sockaddr type. if the buffer isn't large enough, certain system
980 calls will return a truncated address. */
982 #if defined (HAVE_UNIX_DOMAIN_SOCKETS)
983 #define MAX_SIZE_UN sizeof (struct sockaddr_un)
985 #define MAX_SIZE_UN 0
988 #if defined (HAVE_IPV6)
989 #define MAX_SIZE_IN6 sizeof (struct sockaddr_in6)
991 #define MAX_SIZE_IN6 0
994 #define MAX_ADDR_SIZE max (max (sizeof (struct sockaddr_in), MAX_SIZE_IN6),\
997 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
999 "Accept a connection on a bound, listening socket.\n"
1001 "are no pending connections in the queue, wait until\n"
1002 "one is available unless the non-blocking option has been\n"
1003 "set on the socket.\n\n"
1004 "The return value is a\n"
1005 "pair in which the @emph{car} is a new socket port for the\n"
1007 "the @emph{cdr} is an object with address information about the\n"
1008 "client which initiated the connection.\n\n"
1009 "@var{sock} does not become part of the\n"
1010 "connection and will continue to accept new requests.")
1011 #define FUNC_NAME s_scm_accept
1017 int addr_size
= MAX_ADDR_SIZE
;
1018 char max_addr
[MAX_ADDR_SIZE
];
1019 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1021 sock
= SCM_COERCE_OUTPORT (sock
);
1022 SCM_VALIDATE_OPFPORT (1, sock
);
1023 fd
= SCM_FPORT_FDES (sock
);
1024 newfd
= accept (fd
, addr
, &addr_size
);
1027 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
1028 address
= scm_addr_vector (addr
, FUNC_NAME
);
1029 return scm_cons (newsock
, address
);
1033 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
1035 "Return the address of @var{sock}, in the same form as the\n"
1036 "object returned by @code{accept}. On many systems the address\n"
1037 "of a socket in the @code{AF_FILE} namespace cannot be read.")
1038 #define FUNC_NAME s_scm_getsockname
1041 int addr_size
= MAX_ADDR_SIZE
;
1042 char max_addr
[MAX_ADDR_SIZE
];
1043 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1045 sock
= SCM_COERCE_OUTPORT (sock
);
1046 SCM_VALIDATE_OPFPORT (1,sock
);
1047 fd
= SCM_FPORT_FDES (sock
);
1048 if (getsockname (fd
, addr
, &addr_size
) == -1)
1050 return scm_addr_vector (addr
, FUNC_NAME
);
1054 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
1056 "Return the address that @var{sock}\n"
1057 "is connected to, in the same form as the object returned by\n"
1058 "@code{accept}. On many systems the address of a socket in the\n"
1059 "@code{AF_FILE} namespace cannot be read.")
1060 #define FUNC_NAME s_scm_getpeername
1063 int addr_size
= MAX_ADDR_SIZE
;
1064 char max_addr
[MAX_ADDR_SIZE
];
1065 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1067 sock
= SCM_COERCE_OUTPORT (sock
);
1068 SCM_VALIDATE_OPFPORT (1,sock
);
1069 fd
= SCM_FPORT_FDES (sock
);
1070 if (getpeername (fd
, addr
, &addr_size
) == -1)
1072 return scm_addr_vector (addr
, FUNC_NAME
);
1076 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
1077 (SCM sock
, SCM buf
, SCM flags
),
1078 "Receive data from a socket port.\n"
1079 "@var{sock} must already\n"
1080 "be bound to the address from which data is to be received.\n"
1081 "@var{buf} is a string into which\n"
1082 "the data will be written. The size of @var{buf} limits\n"
1084 "data which can be received: in the case of packet\n"
1085 "protocols, if a packet larger than this limit is encountered\n"
1087 "will be irrevocably lost.\n\n"
1088 "The optional @var{flags} argument is a value or\n"
1089 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1090 "The value returned is the number of bytes read from the\n"
1092 "Note that the data is read directly from the socket file\n"
1094 "any unread buffered port data is ignored.")
1095 #define FUNC_NAME s_scm_recv
1101 SCM_VALIDATE_OPFPORT (1,sock
);
1102 SCM_VALIDATE_STRING (2,buf
);
1103 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
1104 fd
= SCM_FPORT_FDES (sock
);
1106 SCM_SYSCALL (rv
= recv (fd
, SCM_STRING_CHARS (buf
), SCM_STRING_LENGTH (buf
), flg
));
1110 return SCM_MAKINUM (rv
);
1114 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
1115 (SCM sock
, SCM message
, SCM flags
),
1116 "Transmit the string @var{message} on a socket port @var{sock}.\n"
1117 "@var{sock} must already be bound to a destination address. The\n"
1118 "value returned is the number of bytes transmitted --\n"
1119 "it's possible for\n"
1120 "this to be less than the length of @var{message}\n"
1121 "if the socket is\n"
1122 "set to be non-blocking. The optional @var{flags} argument\n"
1124 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1125 "Note that the data is written directly to the socket\n"
1126 "file descriptor:\n"
1127 "any unflushed buffered port data is ignored.")
1128 #define FUNC_NAME s_scm_send
1134 sock
= SCM_COERCE_OUTPORT (sock
);
1135 SCM_VALIDATE_OPFPORT (1,sock
);
1136 SCM_VALIDATE_STRING (2, message
);
1137 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
1138 fd
= SCM_FPORT_FDES (sock
);
1140 SCM_SYSCALL (rv
= send (fd
, SCM_STRING_CHARS (message
), SCM_STRING_LENGTH (message
), flg
));
1143 return SCM_MAKINUM (rv
);
1147 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
1148 (SCM sock
, SCM str
, SCM flags
, SCM start
, SCM end
),
1149 "Return data from the socket port @var{sock} and also\n"
1150 "information about where the data was received from.\n"
1151 "@var{sock} must already be bound to the address from which\n"
1152 "data is to be received. @code{str}, is a string into which the\n"
1153 "data will be written. The size of @var{str} limits the amount\n"
1154 "of data which can be received: in the case of packet protocols,\n"
1155 "if a packet larger than this limit is encountered then some\n"
1156 "data will be irrevocably lost.\n\n"
1157 "The optional @var{flags} argument is a value or bitwise OR of\n"
1158 "@code{MSG_OOB}, @code{MSG_PEEK}, @code{MSG_DONTROUTE} etc.\n\n"
1159 "The value returned is a pair: the @emph{car} is the number of\n"
1160 "bytes read from the socket and the @emph{cdr} an address object\n"
1161 "in the same form as returned by @code{accept}. The address\n"
1162 "will given as @code{#f} if not available, as is usually the\n"
1163 "case for stream sockets.\n\n"
1164 "The @var{start} and @var{end} arguments specify a substring of\n"
1165 "@var{str} to which the data should be written.\n\n"
1166 "Note that the data is read directly from the socket file\n"
1167 "descriptor: any unread buffered port data is ignored.")
1168 #define FUNC_NAME s_scm_recvfrom
1177 int addr_size
= MAX_ADDR_SIZE
;
1178 char max_addr
[MAX_ADDR_SIZE
];
1179 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1181 SCM_VALIDATE_OPFPORT (1,sock
);
1182 fd
= SCM_FPORT_FDES (sock
);
1183 SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, str
, buf
, 4, start
, offset
,
1185 if (SCM_UNBNDP (flags
))
1188 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
1190 /* recvfrom will not necessarily return an address. usually nothing
1191 is returned for stream sockets. */
1192 addr
->sa_family
= AF_UNSPEC
;
1193 SCM_SYSCALL (rv
= recvfrom (fd
, buf
+ offset
,
1198 if (addr
->sa_family
!= AF_UNSPEC
)
1199 address
= scm_addr_vector (addr
, FUNC_NAME
);
1201 address
= SCM_BOOL_F
;
1203 return scm_cons (SCM_MAKINUM (rv
), address
);
1207 SCM_DEFINE (scm_sendto
, "sendto", 4, 0, 1,
1208 (SCM sock
, SCM message
, SCM fam
, SCM address
, SCM args_and_flags
),
1209 "Transmit the string @var{message} on the socket port\n"
1211 "destination address is specified using the @var{fam},\n"
1212 "@var{address} and\n"
1213 "@var{args_and_flags} arguments, in a similar way to the\n"
1214 "@code{connect} procedure. @var{args_and_flags} contains\n"
1215 "the usual connection arguments optionally followed by\n"
1216 "a flags argument, which is a value or\n"
1217 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1218 "The value returned is the number of bytes transmitted --\n"
1219 "it's possible for\n"
1220 "this to be less than the length of @var{message} if the\n"
1222 "set to be non-blocking.\n"
1223 "Note that the data is written directly to the socket\n"
1224 "file descriptor:\n"
1225 "any unflushed buffered port data is ignored.")
1226 #define FUNC_NAME s_scm_sendto
1231 struct sockaddr
*soka
;
1234 sock
= SCM_COERCE_OUTPORT (sock
);
1235 SCM_VALIDATE_FPORT (1,sock
);
1236 SCM_VALIDATE_STRING (2, message
);
1237 SCM_VALIDATE_INUM (3,fam
);
1238 fd
= SCM_FPORT_FDES (sock
);
1239 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args_and_flags
, 4,
1241 if (SCM_NULLP (args_and_flags
))
1245 SCM_VALIDATE_CONS (5,args_and_flags
);
1246 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
1248 SCM_SYSCALL (rv
= sendto (fd
, SCM_STRING_CHARS (message
),
1249 SCM_STRING_LENGTH (message
),
1253 int save_errno
= errno
;
1259 return SCM_MAKINUM (rv
);
1268 /* protocol families. */
1270 scm_c_define ("AF_UNSPEC", SCM_MAKINUM (AF_UNSPEC
));
1273 scm_c_define ("AF_UNIX", SCM_MAKINUM (AF_UNIX
));
1276 scm_c_define ("AF_INET", SCM_MAKINUM (AF_INET
));
1279 scm_c_define ("AF_INET6", SCM_MAKINUM (AF_INET6
));
1283 scm_c_define ("PF_UNSPEC", SCM_MAKINUM (PF_UNSPEC
));
1286 scm_c_define ("PF_UNIX", SCM_MAKINUM (PF_UNIX
));
1289 scm_c_define ("PF_INET", SCM_MAKINUM (PF_INET
));
1292 scm_c_define ("PF_INET6", SCM_MAKINUM (PF_INET6
));
1295 /* standard addresses. */
1297 scm_c_define ("INADDR_ANY", scm_ulong2num (INADDR_ANY
));
1299 #ifdef INADDR_BROADCAST
1300 scm_c_define ("INADDR_BROADCAST", scm_ulong2num (INADDR_BROADCAST
));
1303 scm_c_define ("INADDR_NONE", scm_ulong2num (INADDR_NONE
));
1305 #ifdef INADDR_LOOPBACK
1306 scm_c_define ("INADDR_LOOPBACK", scm_ulong2num (INADDR_LOOPBACK
));
1311 scm_c_define ("SOCK_STREAM", SCM_MAKINUM (SOCK_STREAM
));
1314 scm_c_define ("SOCK_DGRAM", SCM_MAKINUM (SOCK_DGRAM
));
1317 scm_c_define ("SOCK_RAW", SCM_MAKINUM (SOCK_RAW
));
1320 /* setsockopt level. */
1322 scm_c_define ("SOL_SOCKET", SCM_MAKINUM (SOL_SOCKET
));
1325 scm_c_define ("SOL_IP", SCM_MAKINUM (SOL_IP
));
1328 scm_c_define ("SOL_TCP", SCM_MAKINUM (SOL_TCP
));
1331 scm_c_define ("SOL_UDP", SCM_MAKINUM (SOL_UDP
));
1334 /* setsockopt names. */
1336 scm_c_define ("SO_DEBUG", SCM_MAKINUM (SO_DEBUG
));
1339 scm_c_define ("SO_REUSEADDR", SCM_MAKINUM (SO_REUSEADDR
));
1342 scm_c_define ("SO_STYLE", SCM_MAKINUM (SO_STYLE
));
1345 scm_c_define ("SO_TYPE", SCM_MAKINUM (SO_TYPE
));
1348 scm_c_define ("SO_ERROR", SCM_MAKINUM (SO_ERROR
));
1351 scm_c_define ("SO_DONTROUTE", SCM_MAKINUM (SO_DONTROUTE
));
1354 scm_c_define ("SO_BROADCAST", SCM_MAKINUM (SO_BROADCAST
));
1357 scm_c_define ("SO_SNDBUF", SCM_MAKINUM (SO_SNDBUF
));
1360 scm_c_define ("SO_RCVBUF", SCM_MAKINUM (SO_RCVBUF
));
1363 scm_c_define ("SO_KEEPALIVE", SCM_MAKINUM (SO_KEEPALIVE
));
1366 scm_c_define ("SO_OOBINLINE", SCM_MAKINUM (SO_OOBINLINE
));
1369 scm_c_define ("SO_NO_CHECK", SCM_MAKINUM (SO_NO_CHECK
));
1372 scm_c_define ("SO_PRIORITY", SCM_MAKINUM (SO_PRIORITY
));
1375 scm_c_define ("SO_LINGER", SCM_MAKINUM (SO_LINGER
));
1378 /* recv/send options. */
1380 scm_c_define ("MSG_OOB", SCM_MAKINUM (MSG_OOB
));
1383 scm_c_define ("MSG_PEEK", SCM_MAKINUM (MSG_PEEK
));
1385 #ifdef MSG_DONTROUTE
1386 scm_c_define ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE
));
1389 scm_add_feature ("socket");
1391 #ifndef SCM_MAGIC_SNARFER
1392 #include "libguile/socket.x"