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 /* we are not currently using socklen_t. it's not defined on all systems,
80 so would need to be checked by configure. in the meantime, plain
81 int is the best alternative. */
85 SCM_DEFINE (scm_htons
, "htons", 1, 0, 0,
87 "Convert a 16 bit quantity from host to network byte ordering.\n"
88 "@var{value} is packed into 2 bytes, which are then converted\n"
89 "and returned as a new integer.")
90 #define FUNC_NAME s_scm_htons
94 SCM_VALIDATE_INUM_COPY (1, value
, c_in
);
95 if (c_in
!= SCM_INUM (value
))
96 SCM_OUT_OF_RANGE (1, value
);
98 return SCM_MAKINUM (htons (c_in
));
102 SCM_DEFINE (scm_ntohs
, "ntohs", 1, 0, 0,
104 "Convert a 16 bit quantity from network to host byte ordering.\n"
105 "@var{value} is packed into 2 bytes, which are then converted\n"
106 "and returned as a new integer.")
107 #define FUNC_NAME s_scm_ntohs
111 SCM_VALIDATE_INUM_COPY (1, value
, c_in
);
112 if (c_in
!= SCM_INUM (value
))
113 SCM_OUT_OF_RANGE (1, value
);
115 return SCM_MAKINUM (ntohs (c_in
));
119 SCM_DEFINE (scm_htonl
, "htonl", 1, 0, 0,
121 "Convert a 32 bit quantity from host to network byte ordering.\n"
122 "@var{value} is packed into 4 bytes, which are then converted\n"
123 "and returned as a new integer.")
124 #define FUNC_NAME s_scm_htonl
126 uint32_t c_in
= SCM_NUM2ULONG (1, value
);
128 return scm_ulong2num (htonl (c_in
));
132 SCM_DEFINE (scm_ntohl
, "ntohl", 1, 0, 0,
134 "Convert a 32 bit quantity from network to host byte ordering.\n"
135 "@var{value} is packed into 4 bytes, which are then converted\n"
136 "and returned as a new integer.")
137 #define FUNC_NAME s_scm_ntohl
139 uint32_t c_in
= SCM_NUM2ULONG (1, value
);
141 return scm_ulong2num (ntohl (c_in
));
145 #ifndef HAVE_INET_ATON
146 /* for our definition in inet_aton.c, not usually needed. */
147 extern int inet_aton ();
150 SCM_DEFINE (scm_inet_aton
, "inet-aton", 1, 0, 0,
152 "Convert an IPv4 Internet address from printable string\n"
153 "(dotted decimal notation) to an integer. E.g.,\n\n"
155 "(inet-aton \"127.0.0.1\") @result{} 2130706433\n"
157 #define FUNC_NAME s_scm_inet_aton
161 SCM_VALIDATE_STRING (1, address
);
162 SCM_STRING_COERCE_0TERMINATION_X (address
);
163 if (inet_aton (SCM_STRING_CHARS (address
), &soka
) == 0)
164 SCM_MISC_ERROR ("bad address", SCM_EOL
);
165 return scm_ulong2num (ntohl (soka
.s_addr
));
170 SCM_DEFINE (scm_inet_ntoa
, "inet-ntoa", 1, 0, 0,
172 "Convert an IPv4 Internet address to a printable\n"
173 "(dotted decimal notation) string. E.g.,\n\n"
175 "(inet-ntoa 2130706433) @result{} \"127.0.0.1\"\n"
177 #define FUNC_NAME s_scm_inet_ntoa
182 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, inetid
));
183 s
= inet_ntoa (addr
);
184 answer
= scm_makfromstr (s
, strlen (s
), 0);
189 #ifdef HAVE_INET_NETOF
190 SCM_DEFINE (scm_inet_netof
, "inet-netof", 1, 0, 0,
192 "Return the network number part of the given IPv4\n"
193 "Internet address. E.g.,\n\n"
195 "(inet-netof 2130706433) @result{} 127\n"
197 #define FUNC_NAME s_scm_inet_netof
200 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
201 return scm_ulong2num ((unsigned long) inet_netof (addr
));
206 #ifdef HAVE_INET_LNAOF
207 SCM_DEFINE (scm_lnaof
, "inet-lnaof", 1, 0, 0,
209 "Return the local-address-with-network part of the given\n"
210 "IPv4 Internet address, using the obsolete class A/B/C system.\n"
213 "(inet-lnaof 2130706433) @result{} 1\n"
215 #define FUNC_NAME s_scm_lnaof
218 addr
.s_addr
= htonl (SCM_NUM2ULONG (1, address
));
219 return scm_ulong2num ((unsigned long) inet_lnaof (addr
));
224 #ifdef HAVE_INET_MAKEADDR
225 SCM_DEFINE (scm_inet_makeaddr
, "inet-makeaddr", 2, 0, 0,
227 "Make an IPv4 Internet address by combining the network number\n"
228 "@var{net} with the local-address-within-network number\n"
229 "@var{lna}. E.g.,\n\n"
231 "(inet-makeaddr 127 1) @result{} 2130706433\n"
233 #define FUNC_NAME s_scm_inet_makeaddr
236 unsigned long netnum
;
237 unsigned long lnanum
;
239 netnum
= SCM_NUM2ULONG (1, net
);
240 lnanum
= SCM_NUM2ULONG (2, lna
);
241 addr
= inet_makeaddr (netnum
, lnanum
);
242 return scm_ulong2num (ntohl (addr
.s_addr
));
249 /* flip a 128 bit IPv6 address between host and network order. */
250 #ifdef WORDS_BIGENDIAN
251 #define FLIP_NET_HOST_128(addr)
253 #define FLIP_NET_HOST_128(addr)\
257 for (i = 0; i < 8; i++)\
261 (addr)[i] = (addr)[15 - i];\
267 /* convert a 128 bit IPv6 address in network order to a host ordered
269 static SCM
ipv6_net_to_num (const char *src
)
271 int big_digits
= 128 / SCM_BITSPERDIG
;
272 const int bytes_per_dig
= SCM_BITSPERDIG
/ 8;
277 memcpy (addr
, src
, 16);
278 /* get rid of leading zeros. */
279 while (big_digits
> 0)
283 memcpy (&test
, ptr
, bytes_per_dig
);
286 ptr
+= bytes_per_dig
;
289 FLIP_NET_HOST_128 (addr
);
290 if (big_digits
* bytes_per_dig
<= sizeof (unsigned long))
292 /* this is just so that we use INUM where possible. */
293 unsigned long l_addr
;
295 memcpy (&l_addr
, addr
, sizeof (unsigned long));
296 result
= scm_ulong2num (l_addr
);
300 result
= scm_mkbig (big_digits
, 0);
301 memcpy (SCM_BDIGITS (result
), addr
, big_digits
* bytes_per_dig
);
306 /* convert a host ordered SCM integer to a 128 bit IPv6 address in
308 static void ipv6_num_to_net (SCM src
, char *dst
)
312 uint32_t addr
= htonl (SCM_INUM (src
));
315 memcpy (dst
+ 12, &addr
, 4);
320 memcpy (dst
, SCM_BDIGITS (src
),
321 SCM_NUMDIGS (src
) * (SCM_BITSPERDIG
/ 8));
322 FLIP_NET_HOST_128 (dst
);
326 /* check that an SCM variable contains an IPv6 integer address. */
327 #define VALIDATE_INET6(which_arg, address)\
328 if (SCM_INUMP (address))\
329 SCM_ASSERT_RANGE (which_arg, address, SCM_INUM (address) >= 0);\
332 SCM_VALIDATE_BIGINT (which_arg, address);\
333 SCM_ASSERT_RANGE (which_arg, address,\
334 !SCM_BIGSIGN (address)\
336 * SCM_NUMDIGS (address) <= 128));\
339 #ifdef HAVE_INET_PTON
340 SCM_DEFINE (scm_inet_pton
, "inet-pton", 2, 0, 0,
341 (SCM family
, SCM address
),
342 "Convert a string containing a printable network address to\n"
343 "an integer address. Note that unlike the C version of this\n"
345 "the result is an integer with normal host byte ordering.\n"
346 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
348 "(inet-pton AF_INET "127.0.0.1") @result{} 2130706433\n"
349 "(inet-pton AF_INET6 "::1") @result{} 1\n"
351 #define FUNC_NAME s_scm_inet_pton
358 SCM_VALIDATE_INUM_COPY (1, family
, af
);
359 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
360 SCM_VALIDATE_STRING_COPY (2, address
, src
);
361 rv
= inet_pton (af
, src
, dst
);
365 SCM_MISC_ERROR ("Bad address", SCM_EOL
);
367 return scm_ulong2num (ntohl (*(uint32_t *) dst
));
369 return ipv6_net_to_num ((char *) dst
);
374 #ifdef HAVE_INET_NTOP
375 SCM_DEFINE (scm_inet_ntop
, "inet-ntop", 2, 0, 0,
376 (SCM family
, SCM address
),
377 "Convert a network address into a printable string.\n"
378 "Note that unlike the C version of this function,\n"
379 "the input is an integer with normal host byte ordering.\n"
380 "@var{family} can be @code{AF_INET} or @code{AF_INET6}. E.g.,\n\n"
382 "(inet-ntop AF_INET 2130706433) @result{} "127.0.0.1"\n"
383 "(inet-ntop AF_INET6 (- (expt 2 128) 1)) @result{}\n"
384 "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff\n"
386 #define FUNC_NAME s_scm_inet_ntop
389 #ifdef INET6_ADDRSTRLEN
390 char dst
[INET6_ADDRSTRLEN
];
396 SCM_VALIDATE_INUM_COPY (1, family
, af
);
397 SCM_ASSERT_RANGE (1, family
, af
== AF_INET
|| af
== AF_INET6
);
399 *(uint32_t *) addr6
= htonl (SCM_NUM2ULONG (2, address
));
402 VALIDATE_INET6 (2, address
);
403 ipv6_num_to_net (address
, addr6
);
405 if (inet_ntop (af
, &addr6
, dst
, sizeof dst
) == NULL
)
407 return scm_makfrom0str (dst
);
412 #endif /* AF_INET6 */
414 SCM_SYMBOL (sym_socket
, "socket");
416 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
418 SCM_DEFINE (scm_socket
, "socket", 3, 0, 0,
419 (SCM family
, SCM style
, SCM proto
),
420 "Return a new socket port of the type specified by @var{family},\n"
421 "@var{style} and @var{proto}. All three parameters are\n"
422 "integers. Supported values for @var{family} are\n"
423 "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
424 "Typical values for @var{style} are @code{SOCK_STREAM},\n"
425 "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
426 "@var{proto} can be obtained from a protocol name using\n"
427 "@code{getprotobyname}. A value of zero specifies the default\n"
428 "protocol, which is usually right.\n\n"
429 "A single socket port cannot by used for communication until it\n"
430 "has been connected to another socket.")
431 #define FUNC_NAME s_scm_socket
435 SCM_VALIDATE_INUM (1, family
);
436 SCM_VALIDATE_INUM (2, style
);
437 SCM_VALIDATE_INUM (3, proto
);
438 fd
= socket (SCM_INUM (family
), SCM_INUM (style
), SCM_INUM (proto
));
441 return SCM_SOCK_FD_TO_PORT (fd
);
445 #ifdef HAVE_SOCKETPAIR
446 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
447 (SCM family
, SCM style
, SCM proto
),
448 "Return a pair of connected (but unnamed) socket ports of the\n"
449 "type specified by @var{family}, @var{style} and @var{proto}.\n"
450 "Many systems support only socket pairs of the @code{AF_UNIX}\n"
451 "family. Zero is likely to be the only meaningful value for\n"
453 #define FUNC_NAME s_scm_socketpair
458 SCM_VALIDATE_INUM (1,family
);
459 SCM_VALIDATE_INUM (2,style
);
460 SCM_VALIDATE_INUM (3,proto
);
462 fam
= SCM_INUM (family
);
464 if (socketpair (fam
, SCM_INUM (style
), SCM_INUM (proto
), fd
) == -1)
467 return scm_cons (SCM_SOCK_FD_TO_PORT (fd
[0]), SCM_SOCK_FD_TO_PORT (fd
[1]));
472 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
473 (SCM sock
, SCM level
, SCM optname
),
474 "Return the value of a particular socket option for the socket\n"
475 "port @var{sock}. @var{level} is an integer code for type of\n"
476 "option being requested, e.g., @code{SOL_SOCKET} for\n"
477 "socket-level options. @var{optname} is an integer code for the\n"
478 "option required and should be specified using one of the\n"
479 "symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n\n"
480 "The returned value is typically an integer but @code{SO_LINGER}\n"
481 "returns a pair of integers.")
482 #define FUNC_NAME s_scm_getsockopt
485 /* size of optval is the largest supported option. */
486 #ifdef HAVE_STRUCT_LINGER
487 char optval
[sizeof (struct linger
)];
488 int optlen
= sizeof (struct linger
);
490 char optval
[sizeof (scm_sizet
)];
491 int optlen
= sizeof (scm_sizet
);
496 sock
= SCM_COERCE_OUTPORT (sock
);
497 SCM_VALIDATE_OPFPORT (1, sock
);
498 SCM_VALIDATE_INUM_COPY (2, level
, ilevel
);
499 SCM_VALIDATE_INUM_COPY (3, optname
, ioptname
);
501 fd
= SCM_FPORT_FDES (sock
);
502 if (getsockopt (fd
, ilevel
, ioptname
, (void *) optval
, &optlen
) == -1)
505 if (ilevel
== SOL_SOCKET
)
508 if (ioptname
== SO_LINGER
)
510 #ifdef HAVE_STRUCT_LINGER
511 struct linger
*ling
= (struct linger
*) optval
;
513 return scm_cons (scm_long2num (ling
->l_onoff
),
514 scm_long2num (ling
->l_linger
));
516 return scm_cons (scm_long2num (*(int *) optval
)
524 || ioptname
== SO_SNDBUF
527 || ioptname
== SO_RCVBUF
531 return scm_long2num (*(scm_sizet
*) optval
);
534 return scm_long2num (*(int *) optval
);
538 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
539 (SCM sock
, SCM level
, SCM optname
, SCM value
),
540 "Set the value of a particular socket option for the socket\n"
541 "port @var{sock}. @var{level} is an integer code for type of option\n"
542 "being set, e.g., @code{SOL_SOCKET} for socket-level options.\n"
543 "@var{optname} is an\n"
544 "integer code for the option to set and should be specified using one of\n"
545 "the symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n"
546 "@var{value} is the value to which the option should be set. For\n"
547 "most options this must be an integer, but for @code{SO_LINGER} it must\n"
549 "The return value is unspecified.")
550 #define FUNC_NAME s_scm_setsockopt
554 /* size of optval is the largest supported option. */
555 #ifdef HAVE_STRUCT_LINGER
556 char optval
[sizeof (struct linger
)];
558 char optval
[sizeof (scm_sizet
)];
560 int ilevel
, ioptname
;
562 sock
= SCM_COERCE_OUTPORT (sock
);
564 SCM_VALIDATE_OPFPORT (1, sock
);
565 SCM_VALIDATE_INUM_COPY (2, level
, ilevel
);
566 SCM_VALIDATE_INUM_COPY (3, optname
, ioptname
);
568 fd
= SCM_FPORT_FDES (sock
);
570 if (ilevel
== SOL_SOCKET
)
573 if (ioptname
== SO_LINGER
)
575 #ifdef HAVE_STRUCT_LINGER
579 SCM_ASSERT (SCM_CONSP (value
), value
, SCM_ARG4
, FUNC_NAME
);
580 lv
= SCM_NUM2LONG (4, SCM_CAR (value
));
581 ling
.l_onoff
= (int) lv
;
582 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
.l_onoff
== lv
);
583 lv
= SCM_NUM2LONG (4, SCM_CDR (value
));
584 ling
.l_linger
= (int) lv
;
585 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
.l_linger
== lv
);
586 optlen
= (int) sizeof (struct linger
);
587 memcpy (optval
, (void *) &ling
, optlen
);
592 SCM_ASSERT (SCM_CONSP (value
), value
, SCM_ARG4
, FUNC_NAME
);
593 /* timeout is ignored, but may as well validate it. */
594 lv
= SCM_NUM2LONG (4, SCM_CDR (value
));
596 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
== lv
);
597 lv
= SCM_NUM2LONG (4, SCM_CAR (value
));
599 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
== lv
);
600 optlen
= (int) sizeof (int);
601 (*(int *) optval
) = ling
;
608 || ioptname
== SO_SNDBUF
611 || ioptname
== SO_RCVBUF
615 long lv
= SCM_NUM2LONG (4, value
);
617 optlen
= (int) sizeof (scm_sizet
);
618 (*(scm_sizet
*) optval
) = (scm_sizet
) lv
;
623 /* Most options take an int. */
624 long lv
= SCM_NUM2LONG (4, value
);
627 SCM_ASSERT_RANGE (SCM_ARG4
, value
, val
== lv
);
628 optlen
= (int) sizeof (int);
629 (*(int *) optval
) = val
;
631 if (setsockopt (fd
, ilevel
, ioptname
, (void *) optval
, optlen
) == -1)
633 return SCM_UNSPECIFIED
;
637 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
639 "Sockets can be closed simply by using @code{close-port}. The\n"
640 "@code{shutdown} procedure allows reception or tranmission on a\n"
641 "connection to be shut down individually, according to the parameter\n"
645 "Stop receiving data for this socket. If further data arrives, reject it.\n"
647 "Stop trying to transmit data from this socket. Discard any\n"
648 "data waiting to be sent. Stop looking for acknowledgement of\n"
649 "data already sent; don't retransmit it if it is lost.\n"
651 "Stop both reception and transmission.\n"
653 "The return value is unspecified.")
654 #define FUNC_NAME s_scm_shutdown
657 sock
= SCM_COERCE_OUTPORT (sock
);
658 SCM_VALIDATE_OPFPORT (1,sock
);
659 SCM_VALIDATE_INUM (2,how
);
660 SCM_ASSERT_RANGE(2,how
,0 <= SCM_INUM (how
) && 2 >= SCM_INUM (how
));
661 fd
= SCM_FPORT_FDES (sock
);
662 if (shutdown (fd
, SCM_INUM (how
)) == -1)
664 return SCM_UNSPECIFIED
;
668 /* convert fam/address/args into a sockaddr of the appropriate type.
669 args is modified by removing the arguments actually used.
670 which_arg and proc are used when reporting errors:
671 which_arg is the position of address in the original argument list.
672 proc is the name of the original procedure.
673 size returns the size of the structure allocated. */
675 static struct sockaddr
*
676 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
677 const char *proc
, int *size
)
678 #define FUNC_NAME proc
684 struct sockaddr_in
*soka
;
688 SCM_VALIDATE_ULONG_COPY (which_arg
, address
, addr
);
689 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
690 SCM_VALIDATE_INUM_COPY (which_arg
+ 1, SCM_CAR (*args
), port
);
691 *args
= SCM_CDR (*args
);
692 soka
= (struct sockaddr_in
*) malloc (sizeof (struct sockaddr_in
));
694 scm_memory_error (proc
);
695 /* 4.4BSD-style interface includes sin_len member and defines SIN_LEN,
698 soka
->sin_len
= sizeof (struct sockaddr_in
);
700 soka
->sin_family
= AF_INET
;
701 soka
->sin_addr
.s_addr
= htonl (addr
);
702 soka
->sin_port
= htons (port
);
703 *size
= sizeof (struct sockaddr_in
);
704 return (struct sockaddr
*) soka
;
711 struct sockaddr_in6
*soka
;
712 unsigned long flowinfo
= 0;
713 unsigned long scope_id
= 0;
715 VALIDATE_INET6 (which_arg
, address
);
716 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
717 SCM_VALIDATE_INUM_COPY (which_arg
+ 1, SCM_CAR (*args
), port
);
718 *args
= SCM_CDR (*args
);
719 if (SCM_CONSP (*args
))
721 SCM_VALIDATE_ULONG_COPY (which_arg
+ 2, SCM_CAR (*args
), flowinfo
);
722 *args
= SCM_CDR (*args
);
723 if (SCM_CONSP (*args
))
725 SCM_VALIDATE_ULONG_COPY (which_arg
+ 3, SCM_CAR (*args
),
727 *args
= SCM_CDR (*args
);
730 soka
= (struct sockaddr_in6
*) malloc (sizeof (struct sockaddr_in6
));
732 scm_memory_error (proc
);
734 soka
->sin6_len
= sizeof (struct sockaddr_in6
);
736 soka
->sin6_family
= AF_INET6
;
737 ipv6_num_to_net (address
, soka
->sin6_addr
.s6_addr
);
738 soka
->sin6_port
= htons (port
);
739 soka
->sin6_flowinfo
= flowinfo
;
740 #ifdef HAVE_SIN6_SCOPE_ID
741 soka
->sin6_scope_id
= scope_id
;
743 *size
= sizeof (struct sockaddr_in6
);
744 return (struct sockaddr
*) soka
;
747 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
750 struct sockaddr_un
*soka
;
753 SCM_ASSERT (SCM_STRINGP (address
), address
, which_arg
, proc
);
754 /* the static buffer size in sockaddr_un seems to be arbitrary
755 and not necessarily a hard limit. e.g., the glibc manual
756 suggests it may be possible to declare it size 0. let's
757 ignore it. if the O/S doesn't like the size it will cause
758 connect/bind etc., to fail. sun_path is always the last
759 member of the structure. */
760 addr_size
= sizeof (struct sockaddr_un
)
761 + max (0, SCM_STRING_LENGTH (address
) + 1 - (sizeof soka
->sun_path
));
762 soka
= (struct sockaddr_un
*) malloc (addr_size
);
764 scm_memory_error (proc
);
765 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
766 soka
->sun_family
= AF_UNIX
;
767 memcpy (soka
->sun_path
, SCM_STRING_CHARS (address
),
768 SCM_STRING_LENGTH (address
));
769 *size
= SUN_LEN (soka
);
770 return (struct sockaddr
*) soka
;
774 scm_out_of_range (proc
, SCM_MAKINUM (fam
));
779 SCM_DEFINE (scm_connect
, "connect", 3, 0, 1,
780 (SCM sock
, SCM fam
, SCM address
, SCM args
),
781 "Initiate a connection from a socket using a specified address\n"
782 "family to the address\n"
783 "specified by @var{address} and possibly @var{args}.\n"
784 "The format required for @var{address}\n"
785 "and @var{args} depends on the family of the socket.\n\n"
786 "For a socket of family @code{AF_UNIX},\n"
787 "only @var{address} is specified and must be a string with the\n"
788 "filename where the socket is to be created.\n\n"
789 "For a socket of family @code{AF_INET},\n"
790 "@var{address} must be an integer IPv4 host address and\n"
791 "@var{args} must be a single integer port number.\n\n"
792 "For a socket of family @code{AF_INET6},\n"
793 "@var{address} must be an integer IPv6 host address and\n"
794 "@var{args} may be up to three integers:\n"
795 "port [flowinfo] [scope_id],\n"
796 "where flowinfo and scope_id default to zero.\n\n"
797 "The return value is unspecified.")
798 #define FUNC_NAME s_scm_connect
801 struct sockaddr
*soka
;
804 sock
= SCM_COERCE_OUTPORT (sock
);
805 SCM_VALIDATE_OPFPORT (1,sock
);
806 SCM_VALIDATE_INUM (2,fam
);
807 fd
= SCM_FPORT_FDES (sock
);
808 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
810 if (connect (fd
, soka
, size
) == -1)
812 int save_errno
= errno
;
819 return SCM_UNSPECIFIED
;
823 SCM_DEFINE (scm_bind
, "bind", 3, 0, 1,
824 (SCM sock
, SCM fam
, SCM address
, SCM args
),
825 "Assign an address to the socket port @var{sock}.\n"
826 "Generally this only needs to be done for server sockets,\n"
827 "so they know where to look for incoming connections. A socket\n"
828 "without an address will be assigned one automatically when it\n"
829 "starts communicating.\n\n"
830 "The format of @var{address} and @var{args} depends\n"
831 "on the family of the socket.\n\n"
832 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
833 "is specified and must be a string with the filename where\n"
834 "the socket is to be created.\n\n"
835 "For a socket of family @code{AF_INET}, @var{address}\n"
836 "must be an integer IPv4 address and @var{args}\n"
837 "must be a single integer port number.\n\n"
838 "The values of the following variables can also be used for\n"
840 "@defvar INADDR_ANY\n"
841 "Allow connections from any address.\n"
843 "@defvar INADDR_LOOPBACK\n"
844 "The address of the local host using the loopback device.\n"
846 "@defvar INADDR_BROADCAST\n"
847 "The broadcast address on the local network.\n"
849 "@defvar INADDR_NONE\n"
852 "For a socket of family @code{AF_INET6}, @var{address}\n"
853 "must be an integer IPv6 address and @var{args}\n"
854 "may be up to three integers:\n"
855 "port [flowinfo] [scope_id],\n"
856 "where flowinfo and scope_id default to zero.\n\n"
857 "The return value is unspecified.")
858 #define FUNC_NAME s_scm_bind
860 struct sockaddr
*soka
;
864 sock
= SCM_COERCE_OUTPORT (sock
);
865 SCM_VALIDATE_OPFPORT (1, sock
);
866 SCM_VALIDATE_INUM (2, fam
);
867 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
869 fd
= SCM_FPORT_FDES (sock
);
870 if (bind (fd
, soka
, size
) == -1)
872 int save_errno
= errno
;
879 return SCM_UNSPECIFIED
;
883 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
884 (SCM sock
, SCM backlog
),
885 "Enable @var{sock} to accept connection\n"
886 "requests. @var{backlog} is an integer specifying\n"
887 "the maximum length of the queue for pending connections.\n"
888 "If the queue fills, new clients will fail to connect until\n"
889 "the server calls @code{accept} to accept a connection from\n"
891 "The return value is unspecified.")
892 #define FUNC_NAME s_scm_listen
895 sock
= SCM_COERCE_OUTPORT (sock
);
896 SCM_VALIDATE_OPFPORT (1,sock
);
897 SCM_VALIDATE_INUM (2,backlog
);
898 fd
= SCM_FPORT_FDES (sock
);
899 if (listen (fd
, SCM_INUM (backlog
)) == -1)
901 return SCM_UNSPECIFIED
;
905 /* Put the components of a sockaddr into a new SCM vector. */
907 scm_addr_vector (const struct sockaddr
*address
, const char *proc
)
909 short int fam
= address
->sa_family
;
917 const struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
919 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
920 ve
= SCM_VELTS (result
);
921 ve
[0] = scm_ulong2num ((unsigned long) fam
);
922 ve
[1] = scm_ulong2num (ntohl (nad
->sin_addr
.s_addr
));
923 ve
[2] = scm_ulong2num ((unsigned long) ntohs (nad
->sin_port
));
929 const struct sockaddr_in6
*nad
= (struct sockaddr_in6
*) address
;
931 result
= scm_c_make_vector (5, SCM_UNSPECIFIED
);
932 ve
= SCM_VELTS (result
);
933 ve
[0] = scm_ulong2num ((unsigned long) fam
);
934 ve
[1] = ipv6_net_to_num (nad
->sin6_addr
.s6_addr
);
935 ve
[2] = scm_ulong2num ((unsigned long) ntohs (nad
->sin6_port
));
936 ve
[3] = scm_ulong2num ((unsigned long) nad
->sin6_flowinfo
);
937 #ifdef HAVE_SIN6_SCOPE_ID
938 ve
[4] = scm_ulong2num ((unsigned long) nad
->sin6_scope_id
);
945 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
948 const struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
950 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
951 ve
= SCM_VELTS (result
);
952 ve
[0] = scm_ulong2num ((unsigned long) fam
);
953 ve
[1] = scm_makfromstr (nad
->sun_path
,
954 (scm_sizet
) strlen (nad
->sun_path
), 0);
959 scm_misc_error (proc
, "Unrecognised address family: ~A",
960 SCM_LIST1 (SCM_MAKINUM (fam
)));
965 /* calculate the size of a buffer large enough to hold any supported
966 sockaddr type. if the buffer isn't large enough, certain system
967 calls will return a truncated address. */
969 #if defined (HAVE_UNIX_DOMAIN_SOCKETS)
970 #define MAX_SIZE_UN sizeof (struct sockaddr_un)
972 #define MAX_SIZE_UN 0
975 #if defined (AF_INET6)
976 #define MAX_SIZE_IN6 sizeof (struct sockaddr_in6)
978 #define MAX_SIZE_IN6 0
981 #define MAX_ADDR_SIZE max (max (sizeof (struct sockaddr_in), MAX_SIZE_IN6),\
984 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
986 "Accept a connection on a bound, listening socket.\n"
988 "are no pending connections in the queue, wait until\n"
989 "one is available unless the non-blocking option has been\n"
990 "set on the socket.\n\n"
991 "The return value is a\n"
992 "pair in which the @emph{car} is a new socket port for the\n"
994 "the @emph{cdr} is an object with address information about the\n"
995 "client which initiated the connection.\n\n"
996 "@var{sock} does not become part of the\n"
997 "connection and will continue to accept new requests.")
998 #define FUNC_NAME s_scm_accept
1004 int addr_size
= MAX_ADDR_SIZE
;
1005 char max_addr
[MAX_ADDR_SIZE
];
1006 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1008 sock
= SCM_COERCE_OUTPORT (sock
);
1009 SCM_VALIDATE_OPFPORT (1, sock
);
1010 fd
= SCM_FPORT_FDES (sock
);
1011 newfd
= accept (fd
, addr
, &addr_size
);
1014 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
1015 address
= scm_addr_vector (addr
, FUNC_NAME
);
1016 return scm_cons (newsock
, address
);
1020 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
1022 "Return the address of @var{sock}, in the same form as the\n"
1023 "object returned by @code{accept}. On many systems the address\n"
1024 "of a socket in the @code{AF_FILE} namespace cannot be read.")
1025 #define FUNC_NAME s_scm_getsockname
1028 int addr_size
= MAX_ADDR_SIZE
;
1029 char max_addr
[MAX_ADDR_SIZE
];
1030 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1032 sock
= SCM_COERCE_OUTPORT (sock
);
1033 SCM_VALIDATE_OPFPORT (1,sock
);
1034 fd
= SCM_FPORT_FDES (sock
);
1035 if (getsockname (fd
, addr
, &addr_size
) == -1)
1037 return scm_addr_vector (addr
, FUNC_NAME
);
1041 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
1043 "Return the address that @var{sock}\n"
1044 "is connected to, in the same form as the object returned by\n"
1045 "@code{accept}. On many systems the address of a socket in the\n"
1046 "@code{AF_FILE} namespace cannot be read.")
1047 #define FUNC_NAME s_scm_getpeername
1050 int addr_size
= MAX_ADDR_SIZE
;
1051 char max_addr
[MAX_ADDR_SIZE
];
1052 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1054 sock
= SCM_COERCE_OUTPORT (sock
);
1055 SCM_VALIDATE_OPFPORT (1,sock
);
1056 fd
= SCM_FPORT_FDES (sock
);
1057 if (getpeername (fd
, addr
, &addr_size
) == -1)
1059 return scm_addr_vector (addr
, FUNC_NAME
);
1063 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
1064 (SCM sock
, SCM buf
, SCM flags
),
1065 "Receive data from a socket port.\n"
1066 "@var{sock} must already\n"
1067 "be bound to the address from which data is to be received.\n"
1068 "@var{buf} is a string into which\n"
1069 "the data will be written. The size of @var{buf} limits\n"
1071 "data which can be received: in the case of packet\n"
1072 "protocols, if a packet larger than this limit is encountered\n"
1074 "will be irrevocably lost.\n\n"
1075 "The optional @var{flags} argument is a value or\n"
1076 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1077 "The value returned is the number of bytes read from the\n"
1079 "Note that the data is read directly from the socket file\n"
1081 "any unread buffered port data is ignored.")
1082 #define FUNC_NAME s_scm_recv
1088 SCM_VALIDATE_OPFPORT (1,sock
);
1089 SCM_VALIDATE_STRING (2,buf
);
1090 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
1091 fd
= SCM_FPORT_FDES (sock
);
1093 SCM_SYSCALL (rv
= recv (fd
, SCM_STRING_CHARS (buf
), SCM_STRING_LENGTH (buf
), flg
));
1097 return SCM_MAKINUM (rv
);
1101 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
1102 (SCM sock
, SCM message
, SCM flags
),
1103 "Transmit the string @var{message} on a socket port @var{sock}.\n"
1104 "@var{sock} must already be bound to a destination address. The\n"
1105 "value returned is the number of bytes transmitted --\n"
1106 "it's possible for\n"
1107 "this to be less than the length of @var{message}\n"
1108 "if the socket is\n"
1109 "set to be non-blocking. The optional @var{flags} argument\n"
1111 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1112 "Note that the data is written directly to the socket\n"
1113 "file descriptor:\n"
1114 "any unflushed buffered port data is ignored.")
1115 #define FUNC_NAME s_scm_send
1121 sock
= SCM_COERCE_OUTPORT (sock
);
1122 SCM_VALIDATE_OPFPORT (1,sock
);
1123 SCM_VALIDATE_STRING (2, message
);
1124 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
1125 fd
= SCM_FPORT_FDES (sock
);
1127 SCM_SYSCALL (rv
= send (fd
, SCM_STRING_CHARS (message
), SCM_STRING_LENGTH (message
), flg
));
1130 return SCM_MAKINUM (rv
);
1134 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
1135 (SCM sock
, SCM str
, SCM flags
, SCM start
, SCM end
),
1136 "Return data from the socket port @var{sock} and also\n"
1137 "information about where the data was received from.\n"
1138 "@var{sock} must already be bound to the address from which\n"
1139 "data is to be received. @code{str}, is a string into which the\n"
1140 "data will be written. The size of @var{str} limits the amount\n"
1141 "of data which can be received: in the case of packet protocols,\n"
1142 "if a packet larger than this limit is encountered then some\n"
1143 "data will be irrevocably lost.\n\n"
1144 "The optional @var{flags} argument is a value or bitwise OR of\n"
1145 "@code{MSG_OOB}, @code{MSG_PEEK}, @code{MSG_DONTROUTE} etc.\n\n"
1146 "The value returned is a pair: the @emph{car} is the number of\n"
1147 "bytes read from the socket and the @emph{cdr} an address object\n"
1148 "in the same form as returned by @code{accept}. The address\n"
1149 "will given as @code{#f} if not available, as is usually the\n"
1150 "case for stream sockets.\n\n"
1151 "The @var{start} and @var{end} arguments specify a substring of\n"
1152 "@var{str} to which the data should be written.\n\n"
1153 "Note that the data is read directly from the socket file\n"
1154 "descriptor: any unread buffered port data is ignored.")
1155 #define FUNC_NAME s_scm_recvfrom
1164 int addr_size
= MAX_ADDR_SIZE
;
1165 char max_addr
[MAX_ADDR_SIZE
];
1166 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
1168 SCM_VALIDATE_OPFPORT (1,sock
);
1169 fd
= SCM_FPORT_FDES (sock
);
1170 SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, str
, buf
, 4, start
, offset
,
1172 if (SCM_UNBNDP (flags
))
1175 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
1177 /* recvfrom will not necessarily return an address. usually nothing
1178 is returned for stream sockets. */
1179 addr
->sa_family
= AF_UNSPEC
;
1180 SCM_SYSCALL (rv
= recvfrom (fd
, buf
+ offset
,
1185 if (addr
->sa_family
!= AF_UNSPEC
)
1186 address
= scm_addr_vector (addr
, FUNC_NAME
);
1188 address
= SCM_BOOL_F
;
1190 return scm_cons (SCM_MAKINUM (rv
), address
);
1194 SCM_DEFINE (scm_sendto
, "sendto", 4, 0, 1,
1195 (SCM sock
, SCM message
, SCM fam
, SCM address
, SCM args_and_flags
),
1196 "Transmit the string @var{message} on the socket port\n"
1198 "destination address is specified using the @var{fam},\n"
1199 "@var{address} and\n"
1200 "@var{args_and_flags} arguments, in a similar way to the\n"
1201 "@code{connect} procedure. @var{args_and_flags} contains\n"
1202 "the usual connection arguments optionally followed by\n"
1203 "a flags argument, which is a value or\n"
1204 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
1205 "The value returned is the number of bytes transmitted --\n"
1206 "it's possible for\n"
1207 "this to be less than the length of @var{message} if the\n"
1209 "set to be non-blocking.\n"
1210 "Note that the data is written directly to the socket\n"
1211 "file descriptor:\n"
1212 "any unflushed buffered port data is ignored.")
1213 #define FUNC_NAME s_scm_sendto
1218 struct sockaddr
*soka
;
1221 sock
= SCM_COERCE_OUTPORT (sock
);
1222 SCM_VALIDATE_FPORT (1,sock
);
1223 SCM_VALIDATE_STRING (2, message
);
1224 SCM_VALIDATE_INUM (3,fam
);
1225 fd
= SCM_FPORT_FDES (sock
);
1226 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args_and_flags
, 4,
1228 if (SCM_NULLP (args_and_flags
))
1232 SCM_VALIDATE_CONS (5,args_and_flags
);
1233 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
1235 SCM_SYSCALL (rv
= sendto (fd
, SCM_STRING_CHARS (message
),
1236 SCM_STRING_LENGTH (message
),
1240 int save_errno
= errno
;
1246 return SCM_MAKINUM (rv
);
1255 /* protocol families. */
1257 scm_sysintern ("AF_UNSPEC", SCM_MAKINUM (AF_UNSPEC
));
1260 scm_sysintern ("AF_UNIX", SCM_MAKINUM (AF_UNIX
));
1263 scm_sysintern ("AF_INET", SCM_MAKINUM (AF_INET
));
1266 scm_sysintern ("AF_INET6", SCM_MAKINUM (AF_INET6
));
1270 scm_sysintern ("PF_UNSPEC", SCM_MAKINUM (PF_UNSPEC
));
1273 scm_sysintern ("PF_UNIX", SCM_MAKINUM (PF_UNIX
));
1276 scm_sysintern ("PF_INET", SCM_MAKINUM (PF_INET
));
1279 scm_sysintern ("PF_INET6", SCM_MAKINUM (PF_INET6
));
1282 /* standard addresses. */
1284 scm_sysintern ("INADDR_ANY", scm_ulong2num (INADDR_ANY
));
1286 #ifdef INADDR_BROADCAST
1287 scm_sysintern ("INADDR_BROADCAST", scm_ulong2num (INADDR_BROADCAST
));
1290 scm_sysintern ("INADDR_NONE", scm_ulong2num (INADDR_NONE
));
1292 #ifdef INADDR_LOOPBACK
1293 scm_sysintern ("INADDR_LOOPBACK", scm_ulong2num (INADDR_LOOPBACK
));
1298 scm_sysintern ("SOCK_STREAM", SCM_MAKINUM (SOCK_STREAM
));
1301 scm_sysintern ("SOCK_DGRAM", SCM_MAKINUM (SOCK_DGRAM
));
1304 scm_sysintern ("SOCK_RAW", SCM_MAKINUM (SOCK_RAW
));
1307 /* setsockopt level. */
1309 scm_sysintern ("SOL_SOCKET", SCM_MAKINUM (SOL_SOCKET
));
1312 scm_sysintern ("SOL_IP", SCM_MAKINUM (SOL_IP
));
1315 scm_sysintern ("SOL_TCP", SCM_MAKINUM (SOL_TCP
));
1318 scm_sysintern ("SOL_UDP", SCM_MAKINUM (SOL_UDP
));
1321 /* setsockopt names. */
1323 scm_sysintern ("SO_DEBUG", SCM_MAKINUM (SO_DEBUG
));
1326 scm_sysintern ("SO_REUSEADDR", SCM_MAKINUM (SO_REUSEADDR
));
1329 scm_sysintern ("SO_STYLE", SCM_MAKINUM (SO_STYLE
));
1332 scm_sysintern ("SO_TYPE", SCM_MAKINUM (SO_TYPE
));
1335 scm_sysintern ("SO_ERROR", SCM_MAKINUM (SO_ERROR
));
1338 scm_sysintern ("SO_DONTROUTE", SCM_MAKINUM (SO_DONTROUTE
));
1341 scm_sysintern ("SO_BROADCAST", SCM_MAKINUM (SO_BROADCAST
));
1344 scm_sysintern ("SO_SNDBUF", SCM_MAKINUM (SO_SNDBUF
));
1347 scm_sysintern ("SO_RCVBUF", SCM_MAKINUM (SO_RCVBUF
));
1350 scm_sysintern ("SO_KEEPALIVE", SCM_MAKINUM (SO_KEEPALIVE
));
1353 scm_sysintern ("SO_OOBINLINE", SCM_MAKINUM (SO_OOBINLINE
));
1356 scm_sysintern ("SO_NO_CHECK", SCM_MAKINUM (SO_NO_CHECK
));
1359 scm_sysintern ("SO_PRIORITY", SCM_MAKINUM (SO_PRIORITY
));
1362 scm_sysintern ("SO_LINGER", SCM_MAKINUM (SO_LINGER
));
1365 /* recv/send options. */
1367 scm_sysintern ("MSG_OOB", SCM_MAKINUM (MSG_OOB
));
1370 scm_sysintern ("MSG_PEEK", SCM_MAKINUM (MSG_PEEK
));
1372 #ifdef MSG_DONTROUTE
1373 scm_sysintern ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE
));
1376 scm_add_feature ("socket");
1378 #ifndef SCM_MAGIC_SNARFER
1379 #include "libguile/socket.x"