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. Typical values for @var{family} are the values of\n"
152 "@code{AF_UNIX} and @code{AF_INET}. Typical values for\n"
153 "@var{style} are the values of @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
)
416 struct sockaddr_in
*soka
;
418 SCM_ASSERT (SCM_CONSP (*args
), *args
,
419 which_arg
+ 1, proc
);
420 isport
= SCM_CAR (*args
);
421 SCM_ASSERT (SCM_INUMP (isport
), isport
, which_arg
+ 1, proc
);
422 soka
= (struct sockaddr_in
*) malloc (sizeof (struct sockaddr_in
));
424 scm_memory_error (proc
);
425 /* e.g., for BSDs which don't like invalid sin_len. */
426 memset (soka
, 0, sizeof (struct sockaddr_in
));
427 soka
->sin_family
= AF_INET
;
428 soka
->sin_addr
.s_addr
=
429 htonl (scm_num2ulong (address
, which_arg
, proc
));
430 *args
= SCM_CDR (*args
);
431 soka
->sin_port
= htons (SCM_INUM (isport
));
432 *size
= sizeof (struct sockaddr_in
);
433 return (struct sockaddr
*) soka
;
435 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
438 struct sockaddr_un
*soka
;
441 SCM_ASSERT (SCM_STRINGP (address
), address
, which_arg
, proc
);
442 /* the static buffer size in sockaddr_un seems to be arbitrary
443 and not necessarily a hard limit. e.g., the glibc manual
444 suggests it may be possible to declare it size 0. let's
445 ignore it. if the O/S doesn't like the size it will cause
446 connect/bind etc., to fail. sun_path is always the last
447 member of the structure. */
448 addr_size
= sizeof (struct sockaddr_un
)
449 + max (0, SCM_STRING_LENGTH (address
) + 1 - (sizeof soka
->sun_path
));
450 soka
= (struct sockaddr_un
*) malloc (addr_size
);
452 scm_memory_error (proc
);
453 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
454 soka
->sun_family
= AF_UNIX
;
455 memcpy (soka
->sun_path
, SCM_STRING_CHARS (address
),
456 SCM_STRING_LENGTH (address
));
457 *size
= SUN_LEN (soka
);
458 return (struct sockaddr
*) soka
;
462 scm_out_of_range (proc
, SCM_MAKINUM (fam
));
466 SCM_DEFINE (scm_connect
, "connect", 3, 0, 1,
467 (SCM sock
, SCM fam
, SCM address
, SCM args
),
468 "Initiates a connection from @var{socket} to the address\n"
469 "specified by @var{address} and possibly @var{arg @dots{}}. The format\n"
470 "required for @var{address}\n"
471 "and @var{arg} @dots{} depends on the family of the socket.\n\n"
472 "For a socket of family @code{AF_UNIX},\n"
473 "only @code{address} is specified and must be a string with the\n"
474 "filename where the socket is to be created.\n\n"
475 "For a socket of family @code{AF_INET},\n"
476 "@code{address} must be an integer Internet host address and @var{arg} @dots{}\n"
477 "must be a single integer port number.\n\n"
478 "The return value is unspecified.")
479 #define FUNC_NAME s_scm_connect
482 struct sockaddr
*soka
;
485 sock
= SCM_COERCE_OUTPORT (sock
);
486 SCM_VALIDATE_OPFPORT (1,sock
);
487 SCM_VALIDATE_INUM (2,fam
);
488 fd
= SCM_FPORT_FDES (sock
);
489 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
491 if (connect (fd
, soka
, size
) == -1)
493 int save_errno
= errno
;
500 return SCM_UNSPECIFIED
;
504 SCM_DEFINE (scm_bind
, "bind", 3, 0, 1,
505 (SCM sock
, SCM fam
, SCM address
, SCM args
),
506 "Assigns an address to the socket port @var{socket}.\n"
507 "Generally this only needs to be done for server sockets,\n"
508 "so they know where to look for incoming connections. A socket\n"
509 "without an address will be assigned one automatically when it\n"
510 "starts communicating.\n\n"
511 "The format of @var{address} and @var{ARG} @dots{} depends on the family\n"
513 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
514 "is specified and must \n"
515 "be a string with the filename where the socket is to be created.\n\n"
516 "For a socket of family @code{AF_INET}, @var{address} must be an integer\n"
517 "Internet host address and @var{arg} @dots{} must be a single integer\n"
519 "The values of the following variables can also be used for @var{address}:\n\n"
520 "@defvar INADDR_ANY\n"
521 "Allow connections from any address.\n"
523 "@defvar INADDR_LOOPBACK\n"
524 "The address of the local host using the loopback device.\n"
526 "@defvar INADDR_BROADCAST\n"
527 "The broadcast address on the local network.\n"
529 "@defvar INADDR_NONE\n"
532 "The return value is unspecified.")
533 #define FUNC_NAME s_scm_bind
535 struct sockaddr
*soka
;
539 sock
= SCM_COERCE_OUTPORT (sock
);
540 SCM_VALIDATE_OPFPORT (1, sock
);
541 SCM_VALIDATE_INUM (2, fam
);
542 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
544 fd
= SCM_FPORT_FDES (sock
);
545 if (bind (fd
, soka
, size
) == -1)
547 int save_errno
= errno
;
554 return SCM_UNSPECIFIED
;
558 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
559 (SCM sock
, SCM backlog
),
560 "This procedure enables @var{socket} to accept connection\n"
561 "requests. @var{backlog} is an integer specifying\n"
562 "the maximum length of the queue for pending connections.\n"
563 "If the queue fills, new clients will fail to connect until the\n"
564 "server calls @code{accept} to accept a connection from the queue.\n\n"
565 "The return value is unspecified.")
566 #define FUNC_NAME s_scm_listen
569 sock
= SCM_COERCE_OUTPORT (sock
);
570 SCM_VALIDATE_OPFPORT (1,sock
);
571 SCM_VALIDATE_INUM (2,backlog
);
572 fd
= SCM_FPORT_FDES (sock
);
573 if (listen (fd
, SCM_INUM (backlog
)) == -1)
575 return SCM_UNSPECIFIED
;
579 /* Put the components of a sockaddr into a new SCM vector. */
581 scm_addr_vector (struct sockaddr
*address
, const char *proc
)
583 short int fam
= address
->sa_family
;
587 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
590 struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
592 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
593 ve
= SCM_VELTS (result
);
594 ve
[0] = scm_ulong2num ((unsigned long) fam
);
595 ve
[1] = scm_makfromstr (nad
->sun_path
,
596 (scm_sizet
) strlen (nad
->sun_path
), 0);
602 struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
604 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
605 ve
= SCM_VELTS (result
);
606 ve
[0] = scm_ulong2num ((unsigned long) fam
);
607 ve
[1] = scm_ulong2num (ntohl (nad
->sin_addr
.s_addr
));
608 ve
[2] = scm_ulong2num ((unsigned long) ntohs (nad
->sin_port
));
611 scm_misc_error (proc
, "Unrecognised address family: ~A",
612 SCM_LIST1 (SCM_MAKINUM (fam
)));
617 /* calculate the size of a buffer large enough to hold any supported
618 sockaddr type. if the buffer isn't large enough, certain system
619 calls will return a truncated address. */
621 #if defined (HAVE_UNIX_DOMAIN_SOCKETS)
622 #define MAX_SIZE_UN sizeof (struct sockaddr_un)
624 #define MAX_SIZE_UN 0
627 #define MAX_ADDR_SIZE max (sizeof (struct sockaddr_in), MAX_SIZE_UN)
629 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
631 "Accepts a connection on a bound, listening socket @var{socket}. If there\n"
632 "are no pending connections in the queue, it waits until\n"
633 "one is available unless the non-blocking option has been set on the\n"
635 "The return value is a\n"
636 "pair in which the CAR is a new socket port for the connection and\n"
637 "the CDR is an object with address information about the client which\n"
638 "initiated the connection.\n\n"
639 "If the address is not available then the CDR will be an empty vector.\n\n"
640 "@var{socket} does not become part of the\n"
641 "connection and will continue to accept new requests.")
642 #define FUNC_NAME s_scm_accept
648 int addr_size
= MAX_ADDR_SIZE
;
649 char max_addr
[MAX_ADDR_SIZE
];
650 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
652 sock
= SCM_COERCE_OUTPORT (sock
);
653 SCM_VALIDATE_OPFPORT (1, sock
);
654 fd
= SCM_FPORT_FDES (sock
);
655 newfd
= accept (fd
, addr
, &addr_size
);
658 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
660 address
= scm_addr_vector (addr
, FUNC_NAME
);
662 address
= SCM_BOOL_F
;
664 return scm_cons (newsock
, address
);
668 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
670 "Return the address of @var{socket}, in the same form as the\n"
671 "object returned by @code{accept}. On many systems the address\n"
672 "of a socket in the @code{AF_FILE} namespace cannot be read.")
673 #define FUNC_NAME s_scm_getsockname
677 int addr_size
= MAX_ADDR_SIZE
;
678 char max_addr
[MAX_ADDR_SIZE
];
679 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
681 sock
= SCM_COERCE_OUTPORT (sock
);
682 SCM_VALIDATE_OPFPORT (1,sock
);
683 fd
= SCM_FPORT_FDES (sock
);
684 if (getsockname (fd
, addr
, &addr_size
) == -1)
687 result
= scm_addr_vector (addr
, FUNC_NAME
);
694 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
696 "Return the address of the socket that the socket @var{socket}\n"
697 "is connected to, in the same form as the object returned by\n"
698 "@code{accept}. On many systems the address of a socket in the\n"
699 "@code{AF_FILE} namespace cannot be read.")
700 #define FUNC_NAME s_scm_getpeername
704 int addr_size
= MAX_ADDR_SIZE
;
705 char max_addr
[MAX_ADDR_SIZE
];
706 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
708 sock
= SCM_COERCE_OUTPORT (sock
);
709 SCM_VALIDATE_OPFPORT (1,sock
);
710 fd
= SCM_FPORT_FDES (sock
);
711 if (getpeername (fd
, addr
, &addr_size
) == -1)
714 result
= scm_addr_vector (addr
, FUNC_NAME
);
721 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
722 (SCM sock
, SCM buf
, SCM flags
),
723 "Receives data from the socket port @var{socket}. @var{socket} must already\n"
724 "be bound to the address from which data is to be received.\n"
725 "@var{buf} is a string into which\n"
726 "the data will be written. The size of @var{buf} limits the amount of\n"
727 "data which can be received: in the case of packet\n"
728 "protocols, if a packet larger than this limit is encountered then some data\n"
729 "will be irrevocably lost.\n\n"
730 "The optional @var{flags} argument is a value or\n"
731 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
732 "The value returned is the number of bytes read from the socket.\n\n"
733 "Note that the data is read directly from the socket file descriptor:\n"
734 "any unread buffered port data is ignored.")
735 #define FUNC_NAME s_scm_recv
741 SCM_VALIDATE_OPFPORT (1,sock
);
742 SCM_VALIDATE_STRING (2,buf
);
743 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
744 fd
= SCM_FPORT_FDES (sock
);
746 SCM_SYSCALL (rv
= recv (fd
, SCM_STRING_CHARS (buf
), SCM_STRING_LENGTH (buf
), flg
));
750 return SCM_MAKINUM (rv
);
754 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
755 (SCM sock
, SCM message
, SCM flags
),
756 "Transmits the string @var{message} on the socket port @var{socket}. \n"
757 "@var{socket} must already be bound to a destination address. The\n"
758 "value returned is the number of bytes transmitted -- it's possible for\n"
759 "this to be less than the length of @var{message} if the socket is\n"
760 "set to be non-blocking. The optional @var{flags} argument is a value or\n"
761 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
762 "Note that the data is written directly to the socket file descriptor:\n"
763 "any unflushed buffered port data is ignored.")
764 #define FUNC_NAME s_scm_send
770 sock
= SCM_COERCE_OUTPORT (sock
);
771 SCM_VALIDATE_OPFPORT (1,sock
);
772 SCM_VALIDATE_STRING (2, message
);
773 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
774 fd
= SCM_FPORT_FDES (sock
);
776 SCM_SYSCALL (rv
= send (fd
, SCM_STRING_CHARS (message
), SCM_STRING_LENGTH (message
), flg
));
779 return SCM_MAKINUM (rv
);
783 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
784 (SCM sock
, SCM str
, SCM flags
, SCM start
, SCM end
),
785 "Return data from the socket port @var{socket} and also\n"
786 "information about where the data was received from.\n"
787 "@var{socket} must already be bound to the address from which\n"
788 "data is to be received. @code{str}, is a string into which the\n"
789 "data will be written. The size of @var{str} limits the amount\n"
790 "of data which can be received: in the case of packet protocols,\n"
791 "if a packet larger than this limit is encountered then some\n"
792 "data will be irrevocably lost.\n"
794 "The optional @var{flags} argument is a value or bitwise OR of\n"
795 "@code{MSG_OOB}, @code{MSG_PEEK}, @code{MSG_DONTROUTE} etc.\n"
797 "The value returned is a pair: the @emph{car} is the number of\n"
798 "bytes read from the socket and the @emph{cdr} an address object\n"
799 "in the same form as returned by @code{accept}.\n"
801 "The @var{start} and @var{end} arguments specify a substring of\n"
802 "@var{str} to which the data should be written.\n"
804 "Note that the data is read directly from the socket file\n"
805 "descriptor: any unread buffered port data is ignored.")
806 #define FUNC_NAME s_scm_recvfrom
815 int addr_size
= MAX_ADDR_SIZE
;
816 char max_addr
[MAX_ADDR_SIZE
];
817 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
819 SCM_VALIDATE_OPFPORT (1,sock
);
820 fd
= SCM_FPORT_FDES (sock
);
821 SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, str
, buf
, 4, start
, offset
,
823 if (SCM_UNBNDP (flags
))
826 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
828 /* recvfrom will not necessarily return an address. usually nothing
829 is returned for stream sockets. */
830 addr
->sa_family
= AF_UNSPEC
;
831 SCM_SYSCALL (rv
= recvfrom (fd
, buf
+ offset
,
836 if (addr_size
> 0 && addr
->sa_family
!= AF_UNSPEC
)
837 address
= scm_addr_vector (addr
, FUNC_NAME
);
839 address
= SCM_BOOL_F
;
841 return scm_cons (SCM_MAKINUM (rv
), address
);
845 SCM_DEFINE (scm_sendto
, "sendto", 4, 0, 1,
846 (SCM sock
, SCM message
, SCM fam
, SCM address
, SCM args_and_flags
),
847 "Transmits the string @var{message} on the socket port @var{socket}. The\n"
848 "destination address is specified using the @var{family}, @var{address} and\n"
849 "@var{arg} arguments, in a similar way to the @code{connect}\n"
851 "value returned is the number of bytes transmitted -- it's possible for\n"
852 "this to be less than the length of @var{message} if the socket is\n"
853 "set to be non-blocking. The optional @var{flags} argument is a value or\n"
854 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
855 "Note that the data is written directly to the socket file descriptor:\n"
856 "any unflushed buffered port data is ignored.")
857 #define FUNC_NAME s_scm_sendto
862 struct sockaddr
*soka
;
865 sock
= SCM_COERCE_OUTPORT (sock
);
866 SCM_VALIDATE_FPORT (1,sock
);
867 SCM_VALIDATE_STRING (2, message
);
868 SCM_VALIDATE_INUM (3,fam
);
869 fd
= SCM_FPORT_FDES (sock
);
870 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args_and_flags
, 4,
872 if (SCM_NULLP (args_and_flags
))
876 SCM_VALIDATE_CONS (5,args_and_flags
);
877 flg
= SCM_NUM2ULONG (5, SCM_CAR (args_and_flags
));
879 SCM_SYSCALL (rv
= sendto (fd
, SCM_STRING_CHARS (message
),
880 SCM_STRING_LENGTH (message
),
884 int save_errno
= errno
;
890 return SCM_MAKINUM (rv
);
899 /* protocol families. */
901 scm_sysintern ("AF_UNSPEC", SCM_MAKINUM (AF_UNSPEC
));
904 scm_sysintern ("AF_UNIX", SCM_MAKINUM (AF_UNIX
));
907 scm_sysintern ("AF_INET", SCM_MAKINUM (AF_INET
));
911 scm_sysintern ("PF_UNSPEC", SCM_MAKINUM (PF_UNSPEC
));
914 scm_sysintern ("PF_UNIX", SCM_MAKINUM (PF_UNIX
));
917 scm_sysintern ("PF_INET", SCM_MAKINUM (PF_INET
));
922 scm_sysintern ("SOCK_STREAM", SCM_MAKINUM (SOCK_STREAM
));
925 scm_sysintern ("SOCK_DGRAM", SCM_MAKINUM (SOCK_DGRAM
));
928 scm_sysintern ("SOCK_RAW", SCM_MAKINUM (SOCK_RAW
));
931 /* setsockopt level. */
933 scm_sysintern ("SOL_SOCKET", SCM_MAKINUM (SOL_SOCKET
));
936 scm_sysintern ("SOL_IP", SCM_MAKINUM (SOL_IP
));
939 scm_sysintern ("SOL_TCP", SCM_MAKINUM (SOL_TCP
));
942 scm_sysintern ("SOL_UDP", SCM_MAKINUM (SOL_UDP
));
945 /* setsockopt names. */
947 scm_sysintern ("SO_DEBUG", SCM_MAKINUM (SO_DEBUG
));
950 scm_sysintern ("SO_REUSEADDR", SCM_MAKINUM (SO_REUSEADDR
));
953 scm_sysintern ("SO_STYLE", SCM_MAKINUM (SO_STYLE
));
956 scm_sysintern ("SO_TYPE", SCM_MAKINUM (SO_TYPE
));
959 scm_sysintern ("SO_ERROR", SCM_MAKINUM (SO_ERROR
));
962 scm_sysintern ("SO_DONTROUTE", SCM_MAKINUM (SO_DONTROUTE
));
965 scm_sysintern ("SO_BROADCAST", SCM_MAKINUM (SO_BROADCAST
));
968 scm_sysintern ("SO_SNDBUF", SCM_MAKINUM (SO_SNDBUF
));
971 scm_sysintern ("SO_RCVBUF", SCM_MAKINUM (SO_RCVBUF
));
974 scm_sysintern ("SO_KEEPALIVE", SCM_MAKINUM (SO_KEEPALIVE
));
977 scm_sysintern ("SO_OOBINLINE", SCM_MAKINUM (SO_OOBINLINE
));
980 scm_sysintern ("SO_NO_CHECK", SCM_MAKINUM (SO_NO_CHECK
));
983 scm_sysintern ("SO_PRIORITY", SCM_MAKINUM (SO_PRIORITY
));
986 scm_sysintern ("SO_LINGER", SCM_MAKINUM (SO_LINGER
));
989 /* recv/send options. */
991 scm_sysintern ("MSG_OOB", SCM_MAKINUM (MSG_OOB
));
994 scm_sysintern ("MSG_PEEK", SCM_MAKINUM (MSG_PEEK
));
997 scm_sysintern ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE
));
1000 scm_add_feature ("socket");
1002 #ifndef SCM_MAGIC_SNARFER
1003 #include "libguile/socket.x"