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
= htons (port
);
504 soka
->sin6_flowinfo
= flowinfo
;
505 #ifdef HAVE_SIN6_SCOPE_ID
506 soka
->sin6_scope_id
= scope_id
;
508 *size
= sizeof (struct sockaddr_in6
);
509 return (struct sockaddr
*) soka
;
512 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
515 struct sockaddr_un
*soka
;
518 SCM_ASSERT (SCM_STRINGP (address
), address
, which_arg
, proc
);
519 /* the static buffer size in sockaddr_un seems to be arbitrary
520 and not necessarily a hard limit. e.g., the glibc manual
521 suggests it may be possible to declare it size 0. let's
522 ignore it. if the O/S doesn't like the size it will cause
523 connect/bind etc., to fail. sun_path is always the last
524 member of the structure. */
525 addr_size
= sizeof (struct sockaddr_un
)
526 + max (0, SCM_STRING_LENGTH (address
) + 1 - (sizeof soka
->sun_path
));
527 soka
= (struct sockaddr_un
*) malloc (addr_size
);
529 scm_memory_error (proc
);
530 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
531 soka
->sun_family
= AF_UNIX
;
532 memcpy (soka
->sun_path
, SCM_STRING_CHARS (address
),
533 SCM_STRING_LENGTH (address
));
534 *size
= SUN_LEN (soka
);
535 return (struct sockaddr
*) soka
;
539 scm_out_of_range (proc
, SCM_MAKINUM (fam
));
544 SCM_DEFINE (scm_connect
, "connect", 3, 0, 1,
545 (SCM sock
, SCM fam
, SCM address
, SCM args
),
546 "Initiates a connection from a socket using a specified address\n"
547 "family to the address\n"
548 "specified by @var{address} and possibly @var{args}.\n"
549 "The format required for @var{address}\n"
550 "and @var{args} depends on the family of the socket.\n\n"
551 "For a socket of family @code{AF_UNIX},\n"
552 "only @var{address} is specified and must be a string with the\n"
553 "filename where the socket is to be created.\n\n"
554 "For a socket of family @code{AF_INET},\n"
555 "@var{address} must be an integer IPv4 host address and\n"
556 "@var{args} must be a single integer port number.\n\n"
557 "For a socket of family @code{AF_INET6},\n"
558 "@var{address} must be an integer IPv6 host address and\n"
559 "@var{args} may be up to three integers:\n"
560 "port [flowinfo] [scope_id],\n"
561 "where flowinfo and scope_id default to zero.\n\n"
562 "The return value is unspecified.")
563 #define FUNC_NAME s_scm_connect
566 struct sockaddr
*soka
;
569 sock
= SCM_COERCE_OUTPORT (sock
);
570 SCM_VALIDATE_OPFPORT (1,sock
);
571 SCM_VALIDATE_INUM (2,fam
);
572 fd
= SCM_FPORT_FDES (sock
);
573 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
575 if (connect (fd
, soka
, size
) == -1)
577 int save_errno
= errno
;
584 return SCM_UNSPECIFIED
;
588 SCM_DEFINE (scm_bind
, "bind", 3, 0, 1,
589 (SCM sock
, SCM fam
, SCM address
, SCM args
),
590 "Assigns an address to the socket port @var{socket}.\n"
591 "Generally this only needs to be done for server sockets,\n"
592 "so they know where to look for incoming connections. A socket\n"
593 "without an address will be assigned one automatically when it\n"
594 "starts communicating.\n\n"
595 "The format of @var{address} and @var{ARG} @dots{} depends on the family\n"
597 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
598 "is specified and must \n"
599 "be a string with the filename where the socket is to be created.\n\n"
600 "For a socket of family @code{AF_INET}, @var{address} must be an integer\n"
601 "Internet host address and @var{arg} @dots{} must be a single integer\n"
603 "The values of the following variables can also be used for @var{address}:\n\n"
604 "@defvar INADDR_ANY\n"
605 "Allow connections from any address.\n"
607 "@defvar INADDR_LOOPBACK\n"
608 "The address of the local host using the loopback device.\n"
610 "@defvar INADDR_BROADCAST\n"
611 "The broadcast address on the local network.\n"
613 "@defvar INADDR_NONE\n"
616 "The return value is unspecified.")
617 #define FUNC_NAME s_scm_bind
619 struct sockaddr
*soka
;
623 sock
= SCM_COERCE_OUTPORT (sock
);
624 SCM_VALIDATE_OPFPORT (1, sock
);
625 SCM_VALIDATE_INUM (2, fam
);
626 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
628 fd
= SCM_FPORT_FDES (sock
);
629 if (bind (fd
, soka
, size
) == -1)
631 int save_errno
= errno
;
638 return SCM_UNSPECIFIED
;
642 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
643 (SCM sock
, SCM backlog
),
644 "This procedure enables @var{socket} to accept connection\n"
645 "requests. @var{backlog} is an integer specifying\n"
646 "the maximum length of the queue for pending connections.\n"
647 "If the queue fills, new clients will fail to connect until the\n"
648 "server calls @code{accept} to accept a connection from the queue.\n\n"
649 "The return value is unspecified.")
650 #define FUNC_NAME s_scm_listen
653 sock
= SCM_COERCE_OUTPORT (sock
);
654 SCM_VALIDATE_OPFPORT (1,sock
);
655 SCM_VALIDATE_INUM (2,backlog
);
656 fd
= SCM_FPORT_FDES (sock
);
657 if (listen (fd
, SCM_INUM (backlog
)) == -1)
659 return SCM_UNSPECIFIED
;
663 /* Put the components of a sockaddr into a new SCM vector. */
665 scm_addr_vector (struct sockaddr
*address
, const char *proc
)
667 short int fam
= address
->sa_family
;
675 struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
677 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
678 ve
= SCM_VELTS (result
);
679 ve
[0] = scm_ulong2num ((unsigned long) fam
);
680 ve
[1] = scm_ulong2num (ntohl (nad
->sin_addr
.s_addr
));
681 ve
[2] = scm_ulong2num ((unsigned long) ntohs (nad
->sin_port
));
687 struct sockaddr_in6
*nad
= (struct sockaddr_in6
*) address
;
689 result
= scm_c_make_vector (5, SCM_UNSPECIFIED
);
690 ve
= SCM_VELTS (result
);
691 ve
[0] = scm_ulong2num ((unsigned long) fam
);
694 ve
[2] = scm_ulong2num ((unsigned long) ntohs (nad
->sin6_port
));
695 ve
[3] = scm_ulong2num ((unsigned long) nad
->sin6_flowinfo
);
696 #ifdef HAVE_SIN6_SCOPE_ID
697 ve
[4] = scm_ulong2num ((unsigned long) nad
->sin6_scope_id
);
704 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
707 struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
709 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
710 ve
= SCM_VELTS (result
);
711 ve
[0] = scm_ulong2num ((unsigned long) fam
);
712 ve
[1] = scm_makfromstr (nad
->sun_path
,
713 (scm_sizet
) strlen (nad
->sun_path
), 0);
718 scm_misc_error (proc
, "Unrecognised address family: ~A",
719 SCM_LIST1 (SCM_MAKINUM (fam
)));
724 /* calculate the size of a buffer large enough to hold any supported
725 sockaddr type. if the buffer isn't large enough, certain system
726 calls will return a truncated address. */
728 #if defined (HAVE_UNIX_DOMAIN_SOCKETS)
729 #define MAX_SIZE_UN sizeof (struct sockaddr_un)
731 #define MAX_SIZE_UN 0
734 #if defined (AF_INET6)
735 #define MAX_SIZE_IN6 sizeof (struct sockaddr_in6)
737 #define MAX_SIZE_IN6 0
740 #define MAX_ADDR_SIZE max (max (sizeof (struct sockaddr_in), MAX_SIZE_IN6),\
743 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
745 "Accepts a connection on a bound, listening socket @var{socket}. If there\n"
746 "are no pending connections in the queue, it waits until\n"
747 "one is available unless the non-blocking option has been set on the\n"
749 "The return value is a\n"
750 "pair in which the CAR is a new socket port for the connection and\n"
751 "the CDR is an object with address information about the client which\n"
752 "initiated the connection.\n\n"
753 "If the address is not available then the CDR will be an empty vector.\n\n"
754 "@var{socket} does not become part of the\n"
755 "connection and will continue to accept new requests.")
756 #define FUNC_NAME s_scm_accept
762 int addr_size
= MAX_ADDR_SIZE
;
763 char max_addr
[MAX_ADDR_SIZE
];
764 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
766 sock
= SCM_COERCE_OUTPORT (sock
);
767 SCM_VALIDATE_OPFPORT (1, sock
);
768 fd
= SCM_FPORT_FDES (sock
);
769 newfd
= accept (fd
, addr
, &addr_size
);
772 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
774 address
= scm_addr_vector (addr
, FUNC_NAME
);
776 address
= SCM_BOOL_F
;
778 return scm_cons (newsock
, address
);
782 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
784 "Return the address of @var{socket}, in the same form as the\n"
785 "object returned by @code{accept}. On many systems the address\n"
786 "of a socket in the @code{AF_FILE} namespace cannot be read.")
787 #define FUNC_NAME s_scm_getsockname
791 int addr_size
= MAX_ADDR_SIZE
;
792 char max_addr
[MAX_ADDR_SIZE
];
793 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
795 sock
= SCM_COERCE_OUTPORT (sock
);
796 SCM_VALIDATE_OPFPORT (1,sock
);
797 fd
= SCM_FPORT_FDES (sock
);
798 if (getsockname (fd
, addr
, &addr_size
) == -1)
801 result
= scm_addr_vector (addr
, FUNC_NAME
);
808 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
810 "Return the address of the socket that the socket @var{socket}\n"
811 "is connected to, in the same form as the object returned by\n"
812 "@code{accept}. On many systems the address of a socket in the\n"
813 "@code{AF_FILE} namespace cannot be read.")
814 #define FUNC_NAME s_scm_getpeername
818 int addr_size
= MAX_ADDR_SIZE
;
819 char max_addr
[MAX_ADDR_SIZE
];
820 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
822 sock
= SCM_COERCE_OUTPORT (sock
);
823 SCM_VALIDATE_OPFPORT (1,sock
);
824 fd
= SCM_FPORT_FDES (sock
);
825 if (getpeername (fd
, addr
, &addr_size
) == -1)
828 result
= scm_addr_vector (addr
, FUNC_NAME
);
835 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
836 (SCM sock
, SCM buf
, SCM flags
),
837 "Receives data from the socket port @var{socket}. @var{socket} must already\n"
838 "be bound to the address from which data is to be received.\n"
839 "@var{buf} is a string into which\n"
840 "the data will be written. The size of @var{buf} limits the amount of\n"
841 "data which can be received: in the case of packet\n"
842 "protocols, if a packet larger than this limit is encountered then some data\n"
843 "will be irrevocably lost.\n\n"
844 "The optional @var{flags} argument is a value or\n"
845 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
846 "The value returned is the number of bytes read from the socket.\n\n"
847 "Note that the data is read directly from the socket file descriptor:\n"
848 "any unread buffered port data is ignored.")
849 #define FUNC_NAME s_scm_recv
855 SCM_VALIDATE_OPFPORT (1,sock
);
856 SCM_VALIDATE_STRING (2,buf
);
857 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
858 fd
= SCM_FPORT_FDES (sock
);
860 SCM_SYSCALL (rv
= recv (fd
, SCM_STRING_CHARS (buf
), SCM_STRING_LENGTH (buf
), flg
));
864 return SCM_MAKINUM (rv
);
868 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
869 (SCM sock
, SCM message
, SCM flags
),
870 "Transmits the string @var{message} on the socket port @var{socket}. \n"
871 "@var{socket} must already be bound to a destination address. The\n"
872 "value returned is the number of bytes transmitted -- it's possible for\n"
873 "this to be less than the length of @var{message} if the socket is\n"
874 "set to be non-blocking. The optional @var{flags} argument is a value or\n"
875 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
876 "Note that the data is written directly to the socket file descriptor:\n"
877 "any unflushed buffered port data is ignored.")
878 #define FUNC_NAME s_scm_send
884 sock
= SCM_COERCE_OUTPORT (sock
);
885 SCM_VALIDATE_OPFPORT (1,sock
);
886 SCM_VALIDATE_STRING (2, message
);
887 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
888 fd
= SCM_FPORT_FDES (sock
);
890 SCM_SYSCALL (rv
= send (fd
, SCM_STRING_CHARS (message
), SCM_STRING_LENGTH (message
), flg
));
893 return SCM_MAKINUM (rv
);
897 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
898 (SCM sock
, SCM str
, SCM flags
, SCM start
, SCM end
),
899 "Return data from the socket port @var{socket} and also\n"
900 "information about where the data was received from.\n"
901 "@var{socket} must already be bound to the address from which\n"
902 "data is to be received. @code{str}, is a string into which the\n"
903 "data will be written. The size of @var{str} limits the amount\n"
904 "of data which can be received: in the case of packet protocols,\n"
905 "if a packet larger than this limit is encountered then some\n"
906 "data will be irrevocably lost.\n"
908 "The optional @var{flags} argument is a value or bitwise OR of\n"
909 "@code{MSG_OOB}, @code{MSG_PEEK}, @code{MSG_DONTROUTE} etc.\n"
911 "The value returned is a pair: the @emph{car} is the number of\n"
912 "bytes read from the socket and the @emph{cdr} an address object\n"
913 "in the same form as returned by @code{accept}.\n"
915 "The @var{start} and @var{end} arguments specify a substring of\n"
916 "@var{str} to which the data should be written.\n"
918 "Note that the data is read directly from the socket file\n"
919 "descriptor: any unread buffered port data is ignored.")
920 #define FUNC_NAME s_scm_recvfrom
929 int addr_size
= MAX_ADDR_SIZE
;
930 char max_addr
[MAX_ADDR_SIZE
];
931 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
933 SCM_VALIDATE_OPFPORT (1,sock
);
934 fd
= SCM_FPORT_FDES (sock
);
935 SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, str
, buf
, 4, start
, offset
,
937 if (SCM_UNBNDP (flags
))
940 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
942 /* recvfrom will not necessarily return an address. usually nothing
943 is returned for stream sockets. */
944 addr
->sa_family
= AF_UNSPEC
;
945 SCM_SYSCALL (rv
= recvfrom (fd
, buf
+ offset
,
950 if (addr_size
> 0 && addr
->sa_family
!= AF_UNSPEC
)
951 address
= scm_addr_vector (addr
, FUNC_NAME
);
953 address
= SCM_BOOL_F
;
955 return scm_cons (SCM_MAKINUM (rv
), address
);
959 SCM_DEFINE (scm_sendto
, "sendto", 4, 0, 1,
960 (SCM sock
, SCM message
, SCM fam
, SCM address
, SCM args_and_flags
),
961 "Transmits the string @var{message} on the socket port @var{socket}. The\n"
962 "destination address is specified using the @var{family}, @var{address} and\n"
963 "@var{arg} arguments, in a similar way to the @code{connect}\n"
965 "value returned is the number of bytes transmitted -- it's possible for\n"
966 "this to be less than the length of @var{message} if the socket is\n"
967 "set to be non-blocking. The optional @var{flags} argument is a value or\n"
968 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
969 "Note that the data is written directly to the socket file descriptor:\n"
970 "any unflushed buffered port data is ignored.")
971 #define FUNC_NAME s_scm_sendto
976 struct sockaddr
*soka
;
979 sock
= SCM_COERCE_OUTPORT (sock
);
980 SCM_VALIDATE_FPORT (1,sock
);
981 SCM_VALIDATE_STRING (2, message
);
982 SCM_VALIDATE_INUM (3,fam
);
983 fd
= SCM_FPORT_FDES (sock
);
984 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args_and_flags
, 4,
986 if (SCM_NULLP (args_and_flags
))
990 SCM_VALIDATE_CONS (5,args_and_flags
);
991 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
993 SCM_SYSCALL (rv
= sendto (fd
, SCM_STRING_CHARS (message
),
994 SCM_STRING_LENGTH (message
),
998 int save_errno
= errno
;
1004 return SCM_MAKINUM (rv
);
1013 /* protocol families. */
1015 scm_sysintern ("AF_UNSPEC", SCM_MAKINUM (AF_UNSPEC
));
1018 scm_sysintern ("AF_UNIX", SCM_MAKINUM (AF_UNIX
));
1021 scm_sysintern ("AF_INET", SCM_MAKINUM (AF_INET
));
1024 scm_sysintern ("AF_INET6", SCM_MAKINUM (AF_INET6
));
1028 scm_sysintern ("PF_UNSPEC", SCM_MAKINUM (PF_UNSPEC
));
1031 scm_sysintern ("PF_UNIX", SCM_MAKINUM (PF_UNIX
));
1034 scm_sysintern ("PF_INET", SCM_MAKINUM (PF_INET
));
1037 scm_sysintern ("PF_INET6", SCM_MAKINUM (PF_INET6
));
1042 scm_sysintern ("SOCK_STREAM", SCM_MAKINUM (SOCK_STREAM
));
1045 scm_sysintern ("SOCK_DGRAM", SCM_MAKINUM (SOCK_DGRAM
));
1048 scm_sysintern ("SOCK_RAW", SCM_MAKINUM (SOCK_RAW
));
1051 /* setsockopt level. */
1053 scm_sysintern ("SOL_SOCKET", SCM_MAKINUM (SOL_SOCKET
));
1056 scm_sysintern ("SOL_IP", SCM_MAKINUM (SOL_IP
));
1059 scm_sysintern ("SOL_TCP", SCM_MAKINUM (SOL_TCP
));
1062 scm_sysintern ("SOL_UDP", SCM_MAKINUM (SOL_UDP
));
1065 /* setsockopt names. */
1067 scm_sysintern ("SO_DEBUG", SCM_MAKINUM (SO_DEBUG
));
1070 scm_sysintern ("SO_REUSEADDR", SCM_MAKINUM (SO_REUSEADDR
));
1073 scm_sysintern ("SO_STYLE", SCM_MAKINUM (SO_STYLE
));
1076 scm_sysintern ("SO_TYPE", SCM_MAKINUM (SO_TYPE
));
1079 scm_sysintern ("SO_ERROR", SCM_MAKINUM (SO_ERROR
));
1082 scm_sysintern ("SO_DONTROUTE", SCM_MAKINUM (SO_DONTROUTE
));
1085 scm_sysintern ("SO_BROADCAST", SCM_MAKINUM (SO_BROADCAST
));
1088 scm_sysintern ("SO_SNDBUF", SCM_MAKINUM (SO_SNDBUF
));
1091 scm_sysintern ("SO_RCVBUF", SCM_MAKINUM (SO_RCVBUF
));
1094 scm_sysintern ("SO_KEEPALIVE", SCM_MAKINUM (SO_KEEPALIVE
));
1097 scm_sysintern ("SO_OOBINLINE", SCM_MAKINUM (SO_OOBINLINE
));
1100 scm_sysintern ("SO_NO_CHECK", SCM_MAKINUM (SO_NO_CHECK
));
1103 scm_sysintern ("SO_PRIORITY", SCM_MAKINUM (SO_PRIORITY
));
1106 scm_sysintern ("SO_LINGER", SCM_MAKINUM (SO_LINGER
));
1109 /* recv/send options. */
1111 scm_sysintern ("MSG_OOB", SCM_MAKINUM (MSG_OOB
));
1114 scm_sysintern ("MSG_PEEK", SCM_MAKINUM (MSG_PEEK
));
1116 #ifdef MSG_DONTROUTE
1117 scm_sysintern ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE
));
1120 scm_add_feature ("socket");
1122 #ifndef SCM_MAGIC_SNARFER
1123 #include "libguile/socket.x"