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 "Return a new integer from @var{value} by converting from host\n"
88 "to network order. @var{value} must be within the range of a C\n"
89 "unsigned short integer.")
90 #define FUNC_NAME s_scm_htons
94 SCM_VALIDATE_INUM_COPY (1,in
,c_in
);
95 if (c_in
!= SCM_INUM (in
))
96 SCM_OUT_OF_RANGE (1,in
);
98 return SCM_MAKINUM (htons (c_in
));
102 SCM_DEFINE (scm_ntohs
, "ntohs", 1, 0, 0,
104 "Return a new integer from @var{value} by converting from\n"
105 "network to host order. @var{value} must be within the range of\n"
106 "a C unsigned short integer.")
107 #define FUNC_NAME s_scm_ntohs
111 SCM_VALIDATE_INUM_COPY (1,in
,c_in
);
112 if (c_in
!= SCM_INUM (in
))
113 SCM_OUT_OF_RANGE (1,in
);
115 return SCM_MAKINUM (ntohs (c_in
));
119 SCM_DEFINE (scm_htonl
, "htonl", 1, 0, 0,
121 "Return a new integer from @var{value} by converting from host\n"
122 "to network order. @var{value} must be within the range of a C\n"
123 "unsigned long integer.")
124 #define FUNC_NAME s_scm_htonl
126 unsigned long c_in
= SCM_NUM2ULONG (1, in
);
127 return scm_ulong2num (htonl (c_in
));
131 SCM_DEFINE (scm_ntohl
, "ntohl", 1, 0, 0,
133 "Return a new integer from @var{value} by converting from\n"
134 "network to host order. @var{value} must be within the range of\n"
135 "a C unsigned long integer.")
136 #define FUNC_NAME s_scm_ntohl
138 unsigned long c_in
= SCM_NUM2ULONG (1, in
);
139 return scm_ulong2num (ntohl (c_in
));
143 SCM_SYMBOL (sym_socket
, "socket");
145 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
147 SCM_DEFINE (scm_socket
, "socket", 3, 0, 0,
148 (SCM family
, SCM style
, SCM proto
),
149 "Return a new socket port of the type specified by @var{family},\n"
150 "@var{style} and @var{protocol}. All three parameters are\n"
151 "integers. Supported values for @var{family} are\n"
152 "@code{AF_UNIX}, @code{AF_INET} and @code{AF_INET6}.\n"
153 "Typical values for @var{style} are @code{SOCK_STREAM},\n"
154 "@code{SOCK_DGRAM} and @code{SOCK_RAW}.\n"
156 "@var{protocol} can be obtained from a protocol name using\n"
157 "@code{getprotobyname}. A value of zero specifies the default\n"
158 "protocol, which is usually right.\n"
160 "A single socket port cannot by used for communication until it\n"
161 "has been connected to another socket.")
162 #define FUNC_NAME s_scm_socket
166 SCM_VALIDATE_INUM (1, family
);
167 SCM_VALIDATE_INUM (2, style
);
168 SCM_VALIDATE_INUM (3, proto
);
169 fd
= socket (SCM_INUM (family
), SCM_INUM (style
), SCM_INUM (proto
));
172 return SCM_SOCK_FD_TO_PORT (fd
);
176 #ifdef HAVE_SOCKETPAIR
177 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
178 (SCM family
, SCM style
, SCM proto
),
179 "Return a pair of connected (but unnamed) socket ports of the\n"
180 "type specified by @var{family}, @var{style} and @var{protocol}.\n"
181 "Many systems support only socket pairs of the @code{AF_UNIX}\n"
182 "family. Zero is likely to be the only meaningful value for\n"
184 #define FUNC_NAME s_scm_socketpair
189 SCM_VALIDATE_INUM (1,family
);
190 SCM_VALIDATE_INUM (2,style
);
191 SCM_VALIDATE_INUM (3,proto
);
193 fam
= SCM_INUM (family
);
195 if (socketpair (fam
, SCM_INUM (style
), SCM_INUM (proto
), fd
) == -1)
198 return scm_cons (SCM_SOCK_FD_TO_PORT (fd
[0]), SCM_SOCK_FD_TO_PORT (fd
[1]));
203 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
204 (SCM sock
, SCM level
, SCM optname
),
205 "Return the value of a particular socket option for the socket\n"
206 "port @var{socket}. @var{level} is an integer code for type of\n"
207 "option being requested, e.g., @code{SOL_SOCKET} for\n"
208 "socket-level options. @var{optname} is an integer code for the\n"
209 "option required and should be specified using one of the\n"
210 "symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n"
212 "The returned value is typically an integer but @code{SO_LINGER}\n"
213 "returns a pair of integers.")
214 #define FUNC_NAME s_scm_getsockopt
217 /* size of optval is the largest supported option. */
218 #ifdef HAVE_STRUCT_LINGER
219 char optval
[sizeof (struct linger
)];
220 int optlen
= sizeof (struct linger
);
222 char optval
[sizeof (scm_sizet
)];
223 int optlen
= sizeof (scm_sizet
);
228 sock
= SCM_COERCE_OUTPORT (sock
);
229 SCM_VALIDATE_OPFPORT (1, sock
);
230 SCM_VALIDATE_INUM_COPY (2, level
, ilevel
);
231 SCM_VALIDATE_INUM_COPY (3, optname
, ioptname
);
233 fd
= SCM_FPORT_FDES (sock
);
234 if (getsockopt (fd
, ilevel
, ioptname
, (void *) optval
, &optlen
) == -1)
237 if (ilevel
== SOL_SOCKET
)
240 if (ioptname
== SO_LINGER
)
242 #ifdef HAVE_STRUCT_LINGER
243 struct linger
*ling
= (struct linger
*) optval
;
245 return scm_cons (scm_long2num (ling
->l_onoff
),
246 scm_long2num (ling
->l_linger
));
248 return scm_cons (scm_long2num (*(int *) optval
)
256 || ioptname
== SO_SNDBUF
259 || ioptname
== SO_RCVBUF
263 return scm_long2num (*(scm_sizet
*) optval
);
266 return scm_long2num (*(int *) optval
);
270 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
271 (SCM sock
, SCM level
, SCM optname
, SCM value
),
272 "Sets the value of a particular socket option for the socket\n"
273 "port @var{socket}. @var{level} is an integer code for type of option\n"
274 "being set, e.g., @code{SOL_SOCKET} for socket-level options.\n"
275 "@var{optname} is an\n"
276 "integer code for the option to set and should be specified using one of\n"
277 "the symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n"
278 "@var{value} is the value to which the option should be set. For\n"
279 "most options this must be an integer, but for @code{SO_LINGER} it must\n"
281 "The return value is unspecified.")
282 #define FUNC_NAME s_scm_setsockopt
286 /* size of optval is the largest supported option. */
287 #ifdef HAVE_STRUCT_LINGER
288 char optval
[sizeof (struct linger
)];
290 char optval
[sizeof (scm_sizet
)];
292 int ilevel
, ioptname
;
294 sock
= SCM_COERCE_OUTPORT (sock
);
296 SCM_VALIDATE_OPFPORT (1, sock
);
297 SCM_VALIDATE_INUM_COPY (2, level
, ilevel
);
298 SCM_VALIDATE_INUM_COPY (3, optname
, ioptname
);
300 fd
= SCM_FPORT_FDES (sock
);
302 if (ilevel
== SOL_SOCKET
)
305 if (ioptname
== SO_LINGER
)
307 #ifdef HAVE_STRUCT_LINGER
311 SCM_ASSERT (SCM_CONSP (value
), value
, SCM_ARG4
, FUNC_NAME
);
312 lv
= SCM_NUM2LONG (4, SCM_CAR (value
));
313 ling
.l_onoff
= (int) lv
;
314 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
.l_onoff
== lv
);
315 lv
= SCM_NUM2LONG (4, SCM_CDR (value
));
316 ling
.l_linger
= (int) lv
;
317 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
.l_linger
== lv
);
318 optlen
= (int) sizeof (struct linger
);
319 memcpy (optval
, (void *) &ling
, optlen
);
324 SCM_ASSERT (SCM_CONSP (value
), value
, SCM_ARG4
, FUNC_NAME
);
325 /* timeout is ignored, but may as well validate it. */
326 lv
= SCM_NUM2LONG (4, SCM_CDR (value
));
328 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
== lv
);
329 lv
= SCM_NUM2LONG (4, SCM_CAR (value
));
331 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
== lv
);
332 optlen
= (int) sizeof (int);
333 (*(int *) optval
) = ling
;
340 || ioptname
== SO_SNDBUF
343 || ioptname
== SO_RCVBUF
347 long lv
= SCM_NUM2LONG (4, value
);
349 optlen
= (int) sizeof (scm_sizet
);
350 (*(scm_sizet
*) optval
) = (scm_sizet
) lv
;
355 /* Most options take an int. */
356 long lv
= SCM_NUM2LONG (4, value
);
359 SCM_ASSERT_RANGE (SCM_ARG4
, value
, val
== lv
);
360 optlen
= (int) sizeof (int);
361 (*(int *) optval
) = val
;
363 if (setsockopt (fd
, ilevel
, ioptname
, (void *) optval
, optlen
) == -1)
365 return SCM_UNSPECIFIED
;
369 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
371 "Sockets can be closed simply by using @code{close-port}. The\n"
372 "@code{shutdown} procedure allows reception or tranmission on a\n"
373 "connection to be shut down individually, according to the parameter\n"
377 "Stop receiving data for this socket. If further data arrives, reject it.\n"
379 "Stop trying to transmit data from this socket. Discard any\n"
380 "data waiting to be sent. Stop looking for acknowledgement of\n"
381 "data already sent; don't retransmit it if it is lost.\n"
383 "Stop both reception and transmission.\n"
385 "The return value is unspecified.")
386 #define FUNC_NAME s_scm_shutdown
389 sock
= SCM_COERCE_OUTPORT (sock
);
390 SCM_VALIDATE_OPFPORT (1,sock
);
391 SCM_VALIDATE_INUM (2,how
);
392 SCM_ASSERT_RANGE(2,how
,0 <= SCM_INUM (how
) && 2 >= SCM_INUM (how
));
393 fd
= SCM_FPORT_FDES (sock
);
394 if (shutdown (fd
, SCM_INUM (how
)) == -1)
396 return SCM_UNSPECIFIED
;
400 /* convert fam/address/args into a sockaddr of the appropriate type.
401 args is modified by removing the arguments actually used.
402 which_arg and proc are used when reporting errors:
403 which_arg is the position of address in the original argument list.
404 proc is the name of the original procedure.
405 size returns the size of the structure allocated. */
407 static struct sockaddr
*
408 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
409 const char *proc
, int *size
)
410 #define FUNC_NAME proc
416 struct sockaddr_in
*soka
;
420 SCM_VALIDATE_ULONG_COPY (which_arg
, address
, addr
);
421 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
422 SCM_VALIDATE_INUM_COPY (which_arg
+ 1, SCM_CAR (*args
), port
);
423 *args
= SCM_CDR (*args
);
424 soka
= (struct sockaddr_in
*) malloc (sizeof (struct sockaddr_in
));
426 scm_memory_error (proc
);
427 /* 4.4BSD-style interface includes sin_len member and defines SIN_LEN,
430 soka
->sin_len
= sizeof (struct sockaddr_in
);
432 soka
->sin_family
= AF_INET
;
433 soka
->sin_addr
.s_addr
= htonl (addr
);
434 soka
->sin_port
= htons (port
);
435 *size
= sizeof (struct sockaddr_in
);
436 return (struct sockaddr
*) soka
;
443 struct sockaddr_in6
*soka
;
444 unsigned long flowinfo
= 0;
445 unsigned long scope_id
= 0;
447 if (SCM_INUMP (address
))
448 SCM_ASSERT_RANGE (which_arg
, address
, SCM_INUM (address
) >= 0);
451 SCM_VALIDATE_BIGINT (which_arg
, address
);
452 SCM_ASSERT_RANGE (which_arg
, address
,
453 !SCM_BIGSIGN (address
)
455 * SCM_NUMDIGS (address
) <= 128));
457 SCM_VALIDATE_CONS (which_arg
+ 1, *args
);
458 SCM_VALIDATE_INUM_COPY (which_arg
+ 1, SCM_CAR (*args
), port
);
459 *args
= SCM_CDR (*args
);
460 if (SCM_CONSP (*args
))
462 SCM_VALIDATE_ULONG_COPY (which_arg
+ 2, SCM_CAR (*args
), flowinfo
);
463 *args
= SCM_CDR (*args
);
464 if (SCM_CONSP (*args
))
466 SCM_VALIDATE_ULONG_COPY (which_arg
+ 3, SCM_CAR (*args
),
468 *args
= SCM_CDR (*args
);
471 soka
= (struct sockaddr_in6
*) malloc (sizeof (struct sockaddr_in6
));
473 scm_memory_error (proc
);
475 soka
->sin6_len
= sizeof (struct sockaddr_in6
);
477 soka
->sin6_family
= AF_INET6
;
478 if (SCM_INUMP (address
))
480 uint32_t addr
= htonl (SCM_INUM (address
));
482 memset (soka
->sin6_addr
.s6_addr
, 0, 12);
483 memcpy (soka
->sin6_addr
.s6_addr
+ 12, &addr
, 4);
489 memset (soka
->sin6_addr
.s6_addr
, 0, 16);
490 memcpy (soka
->sin6_addr
.s6_addr
, SCM_BDIGITS (address
),
491 SCM_NUMDIGS (address
) * (SCM_BITSPERDIG
/ 8));
492 #ifndef WORDS_BIGENDIAN
493 /* flip to network order. */
494 for (i
= 0; i
< 8; i
++)
496 char c
= soka
->sin6_addr
.s6_addr
[i
];
498 soka
->sin6_addr
.s6_addr
[i
] = soka
->sin6_addr
.s6_addr
[15 - i
];
499 soka
->sin6_addr
.s6_addr
[15 - i
] = c
;
503 soka
->sin6_port
= port
;
504 soka
->sin6_flowinfo
= flowinfo
;
505 soka
->sin6_scope_id
= scope_id
;
506 *size
= sizeof (struct sockaddr_in6
);
507 return (struct sockaddr
*) soka
;
510 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
513 struct sockaddr_un
*soka
;
516 SCM_ASSERT (SCM_STRINGP (address
), address
, which_arg
, proc
);
517 /* the static buffer size in sockaddr_un seems to be arbitrary
518 and not necessarily a hard limit. e.g., the glibc manual
519 suggests it may be possible to declare it size 0. let's
520 ignore it. if the O/S doesn't like the size it will cause
521 connect/bind etc., to fail. sun_path is always the last
522 member of the structure. */
523 addr_size
= sizeof (struct sockaddr_un
)
524 + max (0, SCM_STRING_LENGTH (address
) + 1 - (sizeof soka
->sun_path
));
525 soka
= (struct sockaddr_un
*) malloc (addr_size
);
527 scm_memory_error (proc
);
528 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
529 soka
->sun_family
= AF_UNIX
;
530 memcpy (soka
->sun_path
, SCM_STRING_CHARS (address
),
531 SCM_STRING_LENGTH (address
));
532 *size
= SUN_LEN (soka
);
533 return (struct sockaddr
*) soka
;
537 scm_out_of_range (proc
, SCM_MAKINUM (fam
));
542 SCM_DEFINE (scm_connect
, "connect", 3, 0, 1,
543 (SCM sock
, SCM fam
, SCM address
, SCM args
),
544 "Initiates a connection from a socket using a specified address\n"
545 "family to the address\n"
546 "specified by @var{address} and possibly @var{args}.\n"
547 "The format required for @var{address}\n"
548 "and @var{args} depends on the family of the socket.\n\n"
549 "For a socket of family @code{AF_UNIX},\n"
550 "only @var{address} is specified and must be a string with the\n"
551 "filename where the socket is to be created.\n\n"
552 "For a socket of family @code{AF_INET},\n"
553 "@var{address} must be an integer IPv4 host address and\n"
554 "@var{args} must be a single integer port number.\n\n"
555 "For a socket of family @code{AF_INET6},\n"
556 "@var{address} must be an integer IPv6 host address and\n"
557 "@var{args} may be up to three integers:\n"
558 "port [flowinfo] [scope_id],\n"
559 "where flowinfo and scope_id default to zero.\n\n"
560 "The return value is unspecified.")
561 #define FUNC_NAME s_scm_connect
564 struct sockaddr
*soka
;
567 sock
= SCM_COERCE_OUTPORT (sock
);
568 SCM_VALIDATE_OPFPORT (1,sock
);
569 SCM_VALIDATE_INUM (2,fam
);
570 fd
= SCM_FPORT_FDES (sock
);
571 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
573 if (connect (fd
, soka
, size
) == -1)
575 int save_errno
= errno
;
582 return SCM_UNSPECIFIED
;
586 SCM_DEFINE (scm_bind
, "bind", 3, 0, 1,
587 (SCM sock
, SCM fam
, SCM address
, SCM args
),
588 "Assigns an address to the socket port @var{socket}.\n"
589 "Generally this only needs to be done for server sockets,\n"
590 "so they know where to look for incoming connections. A socket\n"
591 "without an address will be assigned one automatically when it\n"
592 "starts communicating.\n\n"
593 "The format of @var{address} and @var{ARG} @dots{} depends on the family\n"
595 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
596 "is specified and must \n"
597 "be a string with the filename where the socket is to be created.\n\n"
598 "For a socket of family @code{AF_INET}, @var{address} must be an integer\n"
599 "Internet host address and @var{arg} @dots{} must be a single integer\n"
601 "The values of the following variables can also be used for @var{address}:\n\n"
602 "@defvar INADDR_ANY\n"
603 "Allow connections from any address.\n"
605 "@defvar INADDR_LOOPBACK\n"
606 "The address of the local host using the loopback device.\n"
608 "@defvar INADDR_BROADCAST\n"
609 "The broadcast address on the local network.\n"
611 "@defvar INADDR_NONE\n"
614 "The return value is unspecified.")
615 #define FUNC_NAME s_scm_bind
617 struct sockaddr
*soka
;
621 sock
= SCM_COERCE_OUTPORT (sock
);
622 SCM_VALIDATE_OPFPORT (1, sock
);
623 SCM_VALIDATE_INUM (2, fam
);
624 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
626 fd
= SCM_FPORT_FDES (sock
);
627 if (bind (fd
, soka
, size
) == -1)
629 int save_errno
= errno
;
636 return SCM_UNSPECIFIED
;
640 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
641 (SCM sock
, SCM backlog
),
642 "This procedure enables @var{socket} to accept connection\n"
643 "requests. @var{backlog} is an integer specifying\n"
644 "the maximum length of the queue for pending connections.\n"
645 "If the queue fills, new clients will fail to connect until the\n"
646 "server calls @code{accept} to accept a connection from the queue.\n\n"
647 "The return value is unspecified.")
648 #define FUNC_NAME s_scm_listen
651 sock
= SCM_COERCE_OUTPORT (sock
);
652 SCM_VALIDATE_OPFPORT (1,sock
);
653 SCM_VALIDATE_INUM (2,backlog
);
654 fd
= SCM_FPORT_FDES (sock
);
655 if (listen (fd
, SCM_INUM (backlog
)) == -1)
657 return SCM_UNSPECIFIED
;
661 /* Put the components of a sockaddr into a new SCM vector. */
663 scm_addr_vector (struct sockaddr
*address
, const char *proc
)
665 short int fam
= address
->sa_family
;
669 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
672 struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
674 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
675 ve
= SCM_VELTS (result
);
676 ve
[0] = scm_ulong2num ((unsigned long) fam
);
677 ve
[1] = scm_makfromstr (nad
->sun_path
,
678 (scm_sizet
) strlen (nad
->sun_path
), 0);
684 struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
686 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
687 ve
= SCM_VELTS (result
);
688 ve
[0] = scm_ulong2num ((unsigned long) fam
);
689 ve
[1] = scm_ulong2num (ntohl (nad
->sin_addr
.s_addr
));
690 ve
[2] = scm_ulong2num ((unsigned long) ntohs (nad
->sin_port
));
693 scm_misc_error (proc
, "Unrecognised address family: ~A",
694 SCM_LIST1 (SCM_MAKINUM (fam
)));
699 /* calculate the size of a buffer large enough to hold any supported
700 sockaddr type. if the buffer isn't large enough, certain system
701 calls will return a truncated address. */
703 #if defined (HAVE_UNIX_DOMAIN_SOCKETS)
704 #define MAX_SIZE_UN sizeof (struct sockaddr_un)
706 #define MAX_SIZE_UN 0
709 #define MAX_ADDR_SIZE max (sizeof (struct sockaddr_in), MAX_SIZE_UN)
711 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
713 "Accepts a connection on a bound, listening socket @var{socket}. If there\n"
714 "are no pending connections in the queue, it waits until\n"
715 "one is available unless the non-blocking option has been set on the\n"
717 "The return value is a\n"
718 "pair in which the CAR is a new socket port for the connection and\n"
719 "the CDR is an object with address information about the client which\n"
720 "initiated the connection.\n\n"
721 "If the address is not available then the CDR will be an empty vector.\n\n"
722 "@var{socket} does not become part of the\n"
723 "connection and will continue to accept new requests.")
724 #define FUNC_NAME s_scm_accept
730 int addr_size
= MAX_ADDR_SIZE
;
731 char max_addr
[MAX_ADDR_SIZE
];
732 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
734 sock
= SCM_COERCE_OUTPORT (sock
);
735 SCM_VALIDATE_OPFPORT (1, sock
);
736 fd
= SCM_FPORT_FDES (sock
);
737 newfd
= accept (fd
, addr
, &addr_size
);
740 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
742 address
= scm_addr_vector (addr
, FUNC_NAME
);
744 address
= SCM_BOOL_F
;
746 return scm_cons (newsock
, address
);
750 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
752 "Return the address of @var{socket}, in the same form as the\n"
753 "object returned by @code{accept}. On many systems the address\n"
754 "of a socket in the @code{AF_FILE} namespace cannot be read.")
755 #define FUNC_NAME s_scm_getsockname
759 int addr_size
= MAX_ADDR_SIZE
;
760 char max_addr
[MAX_ADDR_SIZE
];
761 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
763 sock
= SCM_COERCE_OUTPORT (sock
);
764 SCM_VALIDATE_OPFPORT (1,sock
);
765 fd
= SCM_FPORT_FDES (sock
);
766 if (getsockname (fd
, addr
, &addr_size
) == -1)
769 result
= scm_addr_vector (addr
, FUNC_NAME
);
776 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
778 "Return the address of the socket that the socket @var{socket}\n"
779 "is connected to, in the same form as the object returned by\n"
780 "@code{accept}. On many systems the address of a socket in the\n"
781 "@code{AF_FILE} namespace cannot be read.")
782 #define FUNC_NAME s_scm_getpeername
786 int addr_size
= MAX_ADDR_SIZE
;
787 char max_addr
[MAX_ADDR_SIZE
];
788 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
790 sock
= SCM_COERCE_OUTPORT (sock
);
791 SCM_VALIDATE_OPFPORT (1,sock
);
792 fd
= SCM_FPORT_FDES (sock
);
793 if (getpeername (fd
, addr
, &addr_size
) == -1)
796 result
= scm_addr_vector (addr
, FUNC_NAME
);
803 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
804 (SCM sock
, SCM buf
, SCM flags
),
805 "Receives data from the socket port @var{socket}. @var{socket} must already\n"
806 "be bound to the address from which data is to be received.\n"
807 "@var{buf} is a string into which\n"
808 "the data will be written. The size of @var{buf} limits the amount of\n"
809 "data which can be received: in the case of packet\n"
810 "protocols, if a packet larger than this limit is encountered then some data\n"
811 "will be irrevocably lost.\n\n"
812 "The optional @var{flags} argument is a value or\n"
813 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
814 "The value returned is the number of bytes read from the socket.\n\n"
815 "Note that the data is read directly from the socket file descriptor:\n"
816 "any unread buffered port data is ignored.")
817 #define FUNC_NAME s_scm_recv
823 SCM_VALIDATE_OPFPORT (1,sock
);
824 SCM_VALIDATE_STRING (2,buf
);
825 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
826 fd
= SCM_FPORT_FDES (sock
);
828 SCM_SYSCALL (rv
= recv (fd
, SCM_STRING_CHARS (buf
), SCM_STRING_LENGTH (buf
), flg
));
832 return SCM_MAKINUM (rv
);
836 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
837 (SCM sock
, SCM message
, SCM flags
),
838 "Transmits the string @var{message} on the socket port @var{socket}. \n"
839 "@var{socket} must already be bound to a destination address. The\n"
840 "value returned is the number of bytes transmitted -- it's possible for\n"
841 "this to be less than the length of @var{message} if the socket is\n"
842 "set to be non-blocking. The optional @var{flags} argument is a value or\n"
843 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
844 "Note that the data is written directly to the socket file descriptor:\n"
845 "any unflushed buffered port data is ignored.")
846 #define FUNC_NAME s_scm_send
852 sock
= SCM_COERCE_OUTPORT (sock
);
853 SCM_VALIDATE_OPFPORT (1,sock
);
854 SCM_VALIDATE_STRING (2, message
);
855 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
856 fd
= SCM_FPORT_FDES (sock
);
858 SCM_SYSCALL (rv
= send (fd
, SCM_STRING_CHARS (message
), SCM_STRING_LENGTH (message
), flg
));
861 return SCM_MAKINUM (rv
);
865 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
866 (SCM sock
, SCM str
, SCM flags
, SCM start
, SCM end
),
867 "Return data from the socket port @var{socket} and also\n"
868 "information about where the data was received from.\n"
869 "@var{socket} must already be bound to the address from which\n"
870 "data is to be received. @code{str}, is a string into which the\n"
871 "data will be written. The size of @var{str} limits the amount\n"
872 "of data which can be received: in the case of packet protocols,\n"
873 "if a packet larger than this limit is encountered then some\n"
874 "data will be irrevocably lost.\n"
876 "The optional @var{flags} argument is a value or bitwise OR of\n"
877 "@code{MSG_OOB}, @code{MSG_PEEK}, @code{MSG_DONTROUTE} etc.\n"
879 "The value returned is a pair: the @emph{car} is the number of\n"
880 "bytes read from the socket and the @emph{cdr} an address object\n"
881 "in the same form as returned by @code{accept}.\n"
883 "The @var{start} and @var{end} arguments specify a substring of\n"
884 "@var{str} to which the data should be written.\n"
886 "Note that the data is read directly from the socket file\n"
887 "descriptor: any unread buffered port data is ignored.")
888 #define FUNC_NAME s_scm_recvfrom
897 int addr_size
= MAX_ADDR_SIZE
;
898 char max_addr
[MAX_ADDR_SIZE
];
899 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
901 SCM_VALIDATE_OPFPORT (1,sock
);
902 fd
= SCM_FPORT_FDES (sock
);
903 SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, str
, buf
, 4, start
, offset
,
905 if (SCM_UNBNDP (flags
))
908 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
910 /* recvfrom will not necessarily return an address. usually nothing
911 is returned for stream sockets. */
912 addr
->sa_family
= AF_UNSPEC
;
913 SCM_SYSCALL (rv
= recvfrom (fd
, buf
+ offset
,
918 if (addr_size
> 0 && addr
->sa_family
!= AF_UNSPEC
)
919 address
= scm_addr_vector (addr
, FUNC_NAME
);
921 address
= SCM_BOOL_F
;
923 return scm_cons (SCM_MAKINUM (rv
), address
);
927 SCM_DEFINE (scm_sendto
, "sendto", 4, 0, 1,
928 (SCM sock
, SCM message
, SCM fam
, SCM address
, SCM args_and_flags
),
929 "Transmits the string @var{message} on the socket port @var{socket}. The\n"
930 "destination address is specified using the @var{family}, @var{address} and\n"
931 "@var{arg} arguments, in a similar way to the @code{connect}\n"
933 "value returned is the number of bytes transmitted -- it's possible for\n"
934 "this to be less than the length of @var{message} if the socket is\n"
935 "set to be non-blocking. The optional @var{flags} argument is a value or\n"
936 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
937 "Note that the data is written directly to the socket file descriptor:\n"
938 "any unflushed buffered port data is ignored.")
939 #define FUNC_NAME s_scm_sendto
944 struct sockaddr
*soka
;
947 sock
= SCM_COERCE_OUTPORT (sock
);
948 SCM_VALIDATE_FPORT (1,sock
);
949 SCM_VALIDATE_STRING (2, message
);
950 SCM_VALIDATE_INUM (3,fam
);
951 fd
= SCM_FPORT_FDES (sock
);
952 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args_and_flags
, 4,
954 if (SCM_NULLP (args_and_flags
))
958 SCM_VALIDATE_CONS (5,args_and_flags
);
959 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
961 SCM_SYSCALL (rv
= sendto (fd
, SCM_STRING_CHARS (message
),
962 SCM_STRING_LENGTH (message
),
966 int save_errno
= errno
;
972 return SCM_MAKINUM (rv
);
981 /* protocol families. */
983 scm_sysintern ("AF_UNSPEC", SCM_MAKINUM (AF_UNSPEC
));
986 scm_sysintern ("AF_UNIX", SCM_MAKINUM (AF_UNIX
));
989 scm_sysintern ("AF_INET", SCM_MAKINUM (AF_INET
));
992 scm_sysintern ("AF_INET6", SCM_MAKINUM (AF_INET6
));
996 scm_sysintern ("PF_UNSPEC", SCM_MAKINUM (PF_UNSPEC
));
999 scm_sysintern ("PF_UNIX", SCM_MAKINUM (PF_UNIX
));
1002 scm_sysintern ("PF_INET", SCM_MAKINUM (PF_INET
));
1005 scm_sysintern ("PF_INET6", SCM_MAKINUM (PF_INET6
));
1010 scm_sysintern ("SOCK_STREAM", SCM_MAKINUM (SOCK_STREAM
));
1013 scm_sysintern ("SOCK_DGRAM", SCM_MAKINUM (SOCK_DGRAM
));
1016 scm_sysintern ("SOCK_RAW", SCM_MAKINUM (SOCK_RAW
));
1019 /* setsockopt level. */
1021 scm_sysintern ("SOL_SOCKET", SCM_MAKINUM (SOL_SOCKET
));
1024 scm_sysintern ("SOL_IP", SCM_MAKINUM (SOL_IP
));
1027 scm_sysintern ("SOL_TCP", SCM_MAKINUM (SOL_TCP
));
1030 scm_sysintern ("SOL_UDP", SCM_MAKINUM (SOL_UDP
));
1033 /* setsockopt names. */
1035 scm_sysintern ("SO_DEBUG", SCM_MAKINUM (SO_DEBUG
));
1038 scm_sysintern ("SO_REUSEADDR", SCM_MAKINUM (SO_REUSEADDR
));
1041 scm_sysintern ("SO_STYLE", SCM_MAKINUM (SO_STYLE
));
1044 scm_sysintern ("SO_TYPE", SCM_MAKINUM (SO_TYPE
));
1047 scm_sysintern ("SO_ERROR", SCM_MAKINUM (SO_ERROR
));
1050 scm_sysintern ("SO_DONTROUTE", SCM_MAKINUM (SO_DONTROUTE
));
1053 scm_sysintern ("SO_BROADCAST", SCM_MAKINUM (SO_BROADCAST
));
1056 scm_sysintern ("SO_SNDBUF", SCM_MAKINUM (SO_SNDBUF
));
1059 scm_sysintern ("SO_RCVBUF", SCM_MAKINUM (SO_RCVBUF
));
1062 scm_sysintern ("SO_KEEPALIVE", SCM_MAKINUM (SO_KEEPALIVE
));
1065 scm_sysintern ("SO_OOBINLINE", SCM_MAKINUM (SO_OOBINLINE
));
1068 scm_sysintern ("SO_NO_CHECK", SCM_MAKINUM (SO_NO_CHECK
));
1071 scm_sysintern ("SO_PRIORITY", SCM_MAKINUM (SO_PRIORITY
));
1074 scm_sysintern ("SO_LINGER", SCM_MAKINUM (SO_LINGER
));
1077 /* recv/send options. */
1079 scm_sysintern ("MSG_OOB", SCM_MAKINUM (MSG_OOB
));
1082 scm_sysintern ("MSG_PEEK", SCM_MAKINUM (MSG_PEEK
));
1084 #ifdef MSG_DONTROUTE
1085 scm_sysintern ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE
));
1088 scm_add_feature ("socket");
1090 #ifndef SCM_MAGIC_SNARFER
1091 #include "libguile/socket.x"