1 /* Copyright (C) 1996,1997,1998, 2000 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 /* we are not currently using socklen_t. it's not defined on all systems,
75 so would need to be checked by configure. in the meantime, plain
76 int is the best alternative. */
80 SCM_DEFINE (scm_htons
, "htons", 1, 0, 0,
82 "Returns a new integer from @var{value} by converting from host to\n"
83 "network order. @var{value} must be within the range of a C unsigned\n"
85 #define FUNC_NAME s_scm_htons
89 SCM_VALIDATE_INUM_COPY (1,in
,c_in
);
90 if (c_in
!= SCM_INUM (in
))
91 SCM_OUT_OF_RANGE (1,in
);
93 return SCM_MAKINUM (htons (c_in
));
97 SCM_DEFINE (scm_ntohs
, "ntohs", 1, 0, 0,
99 "Returns a new integer from @var{value} by converting from network to\n"
100 "host order. @var{value} must be within the range of a C unsigned short\n"
102 #define FUNC_NAME s_scm_ntohs
106 SCM_VALIDATE_INUM_COPY (1,in
,c_in
);
107 if (c_in
!= SCM_INUM (in
))
108 SCM_OUT_OF_RANGE (1,in
);
110 return SCM_MAKINUM (ntohs (c_in
));
114 SCM_DEFINE (scm_htonl
, "htonl", 1, 0, 0,
116 "Returns a new integer from @var{value} by converting from host to\n"
117 "network order. @var{value} must be within the range of a C unsigned\n"
119 #define FUNC_NAME s_scm_htonl
121 unsigned long c_in
= SCM_NUM2ULONG (1,in
);
122 return scm_ulong2num (htonl (c_in
));
126 SCM_DEFINE (scm_ntohl
, "ntohl", 1, 0, 0,
128 "Returns a new integer from @var{value} by converting from network to\n"
129 "host order. @var{value} must be within the range of a C unsigned\n"
131 #define FUNC_NAME s_scm_ntohl
133 unsigned long c_in
= SCM_NUM2ULONG (1,in
);
134 return scm_ulong2num (ntohl (c_in
));
138 SCM_SYMBOL (sym_socket
, "socket");
140 #define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
142 SCM_DEFINE (scm_socket
, "socket", 3, 0, 0,
143 (SCM family
, SCM style
, SCM proto
),
144 "Returns a new socket port of the type specified by @var{family}, @var{style}\n"
145 "and @var{protocol}. All three parameters are integers. Typical values\n"
146 "for @var{family} are the values of @code{AF_UNIX}\n"
147 "and @code{AF_INET}. Typical values for @var{style} are\n"
148 "the values of @code{SOCK_STREAM}, @code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
149 "@var{protocol} can be obtained from a protocol name using\n"
150 "@code{getprotobyname}. A value of\n"
151 "zero specifies the default protocol, which is usually right.\n\n"
152 "A single socket port cannot by used for communication until\n"
153 "it has been connected to another socket.")
154 #define FUNC_NAME s_scm_socket
158 SCM_VALIDATE_INUM (1, family
);
159 SCM_VALIDATE_INUM (2, style
);
160 SCM_VALIDATE_INUM (3, proto
);
161 fd
= socket (SCM_INUM (family
), SCM_INUM (style
), SCM_INUM (proto
));
164 return SCM_SOCK_FD_TO_PORT (fd
);
168 #ifdef HAVE_SOCKETPAIR
169 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
170 (SCM family
, SCM style
, SCM proto
),
171 "Returns a pair of connected (but unnamed) socket ports of the type specified\n"
172 "by @var{family}, @var{style} and @var{protocol}.\n"
173 "Many systems support only\n"
174 "socket pairs of the @code{AF_UNIX} family. Zero is likely to be\n"
175 "the only meaningful value for @var{protocol}.")
176 #define FUNC_NAME s_scm_socketpair
181 SCM_VALIDATE_INUM (1,family
);
182 SCM_VALIDATE_INUM (2,style
);
183 SCM_VALIDATE_INUM (3,proto
);
185 fam
= SCM_INUM (family
);
187 if (socketpair (fam
, SCM_INUM (style
), SCM_INUM (proto
), fd
) == -1)
190 return scm_cons (SCM_SOCK_FD_TO_PORT (fd
[0]), SCM_SOCK_FD_TO_PORT (fd
[1]));
195 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
196 (SCM sock
, SCM level
, SCM optname
),
197 "Returns the value of a particular socket option for the socket\n"
198 "port @var{socket}. @var{level} is an integer code for type of option\n"
199 "being requested, e.g., @code{SOL_SOCKET} for socket-level options.\n"
200 "@var{optname} is an\n"
201 "integer code for the option required and should be specified using one of\n"
202 "the symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n\n"
203 "The returned value is typically an integer but @code{SO_LINGER} returns a\n"
205 #define FUNC_NAME s_scm_getsockopt
208 /* size of optval is the largest supported option. */
209 #ifdef HAVE_STRUCT_LINGER
210 char optval
[sizeof (struct linger
)];
211 int optlen
= sizeof (struct linger
);
213 char optval
[sizeof (scm_sizet
)];
214 int optlen
= sizeof (scm_sizet
);
219 sock
= SCM_COERCE_OUTPORT (sock
);
220 SCM_VALIDATE_OPFPORT (1, sock
);
221 SCM_VALIDATE_INUM_COPY (2, level
, ilevel
);
222 SCM_VALIDATE_INUM_COPY (3, optname
, ioptname
);
224 fd
= SCM_FPORT_FDES (sock
);
225 if (getsockopt (fd
, ilevel
, ioptname
, (void *) optval
, &optlen
) == -1)
228 if (ilevel
== SOL_SOCKET
)
231 if (ioptname
== SO_LINGER
)
233 #ifdef HAVE_STRUCT_LINGER
234 struct linger
*ling
= (struct linger
*) optval
;
236 return scm_cons (scm_long2num (ling
->l_onoff
),
237 scm_long2num (ling
->l_linger
));
239 return scm_cons (scm_long2num (*(int *) optval
)
247 || ioptname
== SO_SNDBUF
250 || ioptname
== SO_RCVBUF
254 return scm_long2num (*(scm_sizet
*) optval
);
257 return scm_long2num (*(int *) optval
);
261 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
262 (SCM sock
, SCM level
, SCM optname
, SCM value
),
263 "Sets the value of a particular socket option for the socket\n"
264 "port @var{socket}. @var{level} is an integer code for type of option\n"
265 "being set, e.g., @code{SOL_SOCKET} for socket-level options.\n"
266 "@var{optname} is an\n"
267 "integer code for the option to set and should be specified using one of\n"
268 "the symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n"
269 "@var{value} is the value to which the option should be set. For\n"
270 "most options this must be an integer, but for @code{SO_LINGER} it must\n"
272 "The return value is unspecified.")
273 #define FUNC_NAME s_scm_setsockopt
277 /* size of optval is the largest supported option. */
278 #ifdef HAVE_STRUCT_LINGER
279 char optval
[sizeof (struct linger
)];
281 char optval
[sizeof (scm_sizet
)];
283 int ilevel
, ioptname
;
285 sock
= SCM_COERCE_OUTPORT (sock
);
287 SCM_VALIDATE_OPFPORT (1, sock
);
288 SCM_VALIDATE_INUM_COPY (2, level
, ilevel
);
289 SCM_VALIDATE_INUM_COPY (3, optname
, ioptname
);
291 fd
= SCM_FPORT_FDES (sock
);
293 if (ilevel
== SOL_SOCKET
)
296 if (ioptname
== SO_LINGER
)
298 #ifdef HAVE_STRUCT_LINGER
302 SCM_ASSERT (SCM_CONSP (value
), value
, SCM_ARG4
, FUNC_NAME
);
303 lv
= SCM_NUM2LONG (4, SCM_CAR (value
));
304 ling
.l_onoff
= (int) lv
;
305 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
.l_onoff
== lv
);
306 lv
= SCM_NUM2LONG (4, SCM_CDR (value
));
307 ling
.l_linger
= (int) lv
;
308 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
.l_linger
== lv
);
309 optlen
= (int) sizeof (struct linger
);
310 memcpy (optval
, (void *) &ling
, optlen
);
315 SCM_ASSERT (SCM_CONSP (value
), value
, SCM_ARG4
, FUNC_NAME
);
316 /* timeout is ignored, but may as well validate it. */
317 lv
= SCM_NUM2LONG (4, SCM_CDR (value
));
319 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
== lv
);
320 lv
= SCM_NUM2LONG (4, SCM_CAR (value
));
322 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
== lv
);
323 optlen
= (int) sizeof (int);
324 (*(int *) optval
) = ling
;
331 || ioptname
== SO_SNDBUF
334 || ioptname
== SO_RCVBUF
338 long lv
= SCM_NUM2LONG (4, value
);
340 optlen
= (int) sizeof (scm_sizet
);
341 (*(scm_sizet
*) optval
) = (scm_sizet
) lv
;
346 /* Most options take an int. */
347 long lv
= SCM_NUM2LONG (4, value
);
350 SCM_ASSERT_RANGE (SCM_ARG4
, value
, val
== lv
);
351 optlen
= (int) sizeof (int);
352 (*(int *) optval
) = val
;
354 if (setsockopt (fd
, ilevel
, ioptname
, (void *) optval
, optlen
) == -1)
356 return SCM_UNSPECIFIED
;
360 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
362 "Sockets can be closed simply by using @code{close-port}. The\n"
363 "@code{shutdown} procedure allows reception or tranmission on a\n"
364 "connection to be shut down individually, according to the parameter\n"
368 "Stop receiving data for this socket. If further data arrives, reject it.\n"
370 "Stop trying to transmit data from this socket. Discard any\n"
371 "data waiting to be sent. Stop looking for acknowledgement of\n"
372 "data already sent; don't retransmit it if it is lost.\n"
374 "Stop both reception and transmission.\n"
376 "The return value is unspecified.")
377 #define FUNC_NAME s_scm_shutdown
380 sock
= SCM_COERCE_OUTPORT (sock
);
381 SCM_VALIDATE_OPFPORT (1,sock
);
382 SCM_VALIDATE_INUM (2,how
);
383 SCM_ASSERT_RANGE(2,how
,0 <= SCM_INUM (how
) && 2 >= SCM_INUM (how
));
384 fd
= SCM_FPORT_FDES (sock
);
385 if (shutdown (fd
, SCM_INUM (how
)) == -1)
387 return SCM_UNSPECIFIED
;
391 /* convert fam/address/args into a sockaddr of the appropriate type.
392 args is modified by removing the arguments actually used.
393 which_arg and proc are used when reporting errors:
394 which_arg is the position of address in the original argument list.
395 proc is the name of the original procedure.
396 size returns the size of the structure allocated. */
398 static struct sockaddr
*
399 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
400 const char *proc
, int *size
)
407 struct sockaddr_in
*soka
;
409 SCM_ASSERT (SCM_CONSP (*args
), *args
,
410 which_arg
+ 1, proc
);
411 isport
= SCM_CAR (*args
);
412 SCM_ASSERT (SCM_INUMP (isport
), isport
, which_arg
+ 1, proc
);
413 soka
= (struct sockaddr_in
*) malloc (sizeof (struct sockaddr_in
));
415 scm_memory_error (proc
);
416 /* e.g., for BSDs which don't like invalid sin_len. */
417 memset (soka
, 0, sizeof (struct sockaddr_in
));
418 soka
->sin_family
= AF_INET
;
419 soka
->sin_addr
.s_addr
=
420 htonl (scm_num2ulong (address
, (char *) which_arg
, proc
));
421 *args
= SCM_CDR (*args
);
422 soka
->sin_port
= htons (SCM_INUM (isport
));
423 *size
= sizeof (struct sockaddr_in
);
424 return (struct sockaddr
*) soka
;
426 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
429 struct sockaddr_un
*soka
;
432 SCM_ASSERT (SCM_STRINGP (address
), address
, which_arg
, proc
);
433 /* the static buffer size in sockaddr_un seems to be arbitrary
434 and not necessarily a hard limit. e.g., the glibc manual
435 suggests it may be possible to declare it size 0. let's
436 ignore it. if the O/S doesn't like the size it will cause
437 connect/bind etc., to fail. sun_path is always the last
438 member of the structure. */
439 addr_size
= sizeof (struct sockaddr_un
)
440 + max (0, SCM_STRING_LENGTH (address
) + 1 - (sizeof soka
->sun_path
));
441 soka
= (struct sockaddr_un
*) malloc (addr_size
);
443 scm_memory_error (proc
);
444 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
445 soka
->sun_family
= AF_UNIX
;
446 memcpy (soka
->sun_path
, SCM_STRING_CHARS (address
),
447 SCM_STRING_LENGTH (address
));
448 *size
= SUN_LEN (soka
);
449 return (struct sockaddr
*) soka
;
453 scm_out_of_range (proc
, SCM_MAKINUM (fam
));
457 SCM_DEFINE (scm_connect
, "connect", 3, 0, 1,
458 (SCM sock
, SCM fam
, SCM address
, SCM args
),
459 "Initiates a connection from @var{socket} to the address\n"
460 "specified by @var{address} and possibly @var{arg @dots{}}. The format\n"
461 "required for @var{address}\n"
462 "and @var{arg} @dots{} depends on the family of the socket.\n\n"
463 "For a socket of family @code{AF_UNIX},\n"
464 "only @code{address} is specified and must be a string with the\n"
465 "filename where the socket is to be created.\n\n"
466 "For a socket of family @code{AF_INET},\n"
467 "@code{address} must be an integer Internet host address and @var{arg} @dots{}\n"
468 "must be a single integer port number.\n\n"
469 "The return value is unspecified.")
470 #define FUNC_NAME s_scm_connect
473 struct sockaddr
*soka
;
476 sock
= SCM_COERCE_OUTPORT (sock
);
477 SCM_VALIDATE_OPFPORT (1,sock
);
478 SCM_VALIDATE_INUM (2,fam
);
479 fd
= SCM_FPORT_FDES (sock
);
480 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
482 if (connect (fd
, soka
, size
) == -1)
484 int save_errno
= errno
;
491 return SCM_UNSPECIFIED
;
495 SCM_DEFINE (scm_bind
, "bind", 3, 0, 1,
496 (SCM sock
, SCM fam
, SCM address
, SCM args
),
497 "Assigns an address to the socket port @var{socket}.\n"
498 "Generally this only needs to be done for server sockets,\n"
499 "so they know where to look for incoming connections. A socket\n"
500 "without an address will be assigned one automatically when it\n"
501 "starts communicating.\n\n"
502 "The format of @var{address} and @var{ARG} @dots{} depends on the family\n"
504 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
505 "is specified and must \n"
506 "be a string with the filename where the socket is to be created.\n\n"
507 "For a socket of family @code{AF_INET}, @var{address} must be an integer\n"
508 "Internet host address and @var{arg} @dots{} must be a single integer\n"
510 "The values of the following variables can also be used for @var{address}:\n\n"
511 "@defvar INADDR_ANY\n"
512 "Allow connections from any address.\n"
514 "@defvar INADDR_LOOPBACK\n"
515 "The address of the local host using the loopback device.\n"
517 "@defvar INADDR_BROADCAST\n"
518 "The broadcast address on the local network.\n"
520 "@defvar INADDR_NONE\n"
523 "The return value is unspecified.")
524 #define FUNC_NAME s_scm_bind
526 struct sockaddr
*soka
;
530 sock
= SCM_COERCE_OUTPORT (sock
);
531 SCM_VALIDATE_OPFPORT (1, sock
);
532 SCM_VALIDATE_INUM (2, fam
);
533 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
535 fd
= SCM_FPORT_FDES (sock
);
536 if (bind (fd
, soka
, size
) == -1)
538 int save_errno
= errno
;
545 return SCM_UNSPECIFIED
;
549 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
550 (SCM sock
, SCM backlog
),
551 "This procedure enables @var{socket} to accept connection\n"
552 "requests. @var{backlog} is an integer specifying\n"
553 "the maximum length of the queue for pending connections.\n"
554 "If the queue fills, new clients will fail to connect until the\n"
555 "server calls @code{accept} to accept a connection from the queue.\n\n"
556 "The return value is unspecified.")
557 #define FUNC_NAME s_scm_listen
560 sock
= SCM_COERCE_OUTPORT (sock
);
561 SCM_VALIDATE_OPFPORT (1,sock
);
562 SCM_VALIDATE_INUM (2,backlog
);
563 fd
= SCM_FPORT_FDES (sock
);
564 if (listen (fd
, SCM_INUM (backlog
)) == -1)
566 return SCM_UNSPECIFIED
;
570 /* Put the components of a sockaddr into a new SCM vector. */
572 scm_addr_vector (struct sockaddr
*address
, const char *proc
)
574 short int fam
= address
->sa_family
;
578 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
581 struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
583 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
584 ve
= SCM_VELTS (result
);
585 ve
[0] = scm_ulong2num ((unsigned long) fam
);
586 ve
[1] = scm_makfromstr (nad
->sun_path
,
587 (scm_sizet
) strlen (nad
->sun_path
), 0);
593 struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
595 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
596 ve
= SCM_VELTS (result
);
597 ve
[0] = scm_ulong2num ((unsigned long) fam
);
598 ve
[1] = scm_ulong2num (ntohl (nad
->sin_addr
.s_addr
));
599 ve
[2] = scm_ulong2num ((unsigned long) ntohs (nad
->sin_port
));
602 scm_misc_error (proc
, "Unrecognised address family: ~A",
603 scm_listify (SCM_MAKINUM (fam
), SCM_UNDEFINED
));
608 /* calculate the size of a buffer large enough to hold any supported
609 sockaddr type. if the buffer isn't large enough, certain system
610 calls will return a truncated address. */
612 #if defined (HAVE_UNIX_DOMAIN_SOCKETS)
613 #define MAX_SIZE_UN sizeof (struct sockaddr_un)
615 #define MAX_SIZE_UN 0
618 #define MAX_ADDR_SIZE max (sizeof (struct sockaddr_in), MAX_SIZE_UN)
620 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
622 "Accepts a connection on a bound, listening socket @var{socket}. If there\n"
623 "are no pending connections in the queue, it waits until\n"
624 "one is available unless the non-blocking option has been set on the\n"
626 "The return value is a\n"
627 "pair in which the CAR is a new socket port for the connection and\n"
628 "the CDR is an object with address information about the client which\n"
629 "initiated the connection.\n\n"
630 "If the address is not available then the CDR will be an empty vector.\n\n"
631 "@var{socket} does not become part of the\n"
632 "connection and will continue to accept new requests.")
633 #define FUNC_NAME s_scm_accept
639 int addr_size
= MAX_ADDR_SIZE
;
640 char max_addr
[MAX_ADDR_SIZE
];
641 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
643 sock
= SCM_COERCE_OUTPORT (sock
);
644 SCM_VALIDATE_OPFPORT (1, sock
);
645 fd
= SCM_FPORT_FDES (sock
);
646 newfd
= accept (fd
, addr
, &addr_size
);
649 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
651 address
= scm_addr_vector (addr
, FUNC_NAME
);
653 address
= SCM_BOOL_F
;
655 return scm_cons (newsock
, address
);
659 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
661 "Returns the address of @var{socket}, in the same form as the object\n"
662 "returned by @code{accept}. On many systems the address of a socket\n"
663 "in the @code{AF_FILE} namespace cannot be read.")
664 #define FUNC_NAME s_scm_getsockname
668 int addr_size
= MAX_ADDR_SIZE
;
669 char max_addr
[MAX_ADDR_SIZE
];
670 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
672 sock
= SCM_COERCE_OUTPORT (sock
);
673 SCM_VALIDATE_OPFPORT (1,sock
);
674 fd
= SCM_FPORT_FDES (sock
);
675 if (getsockname (fd
, addr
, &addr_size
) == -1)
678 result
= scm_addr_vector (addr
, FUNC_NAME
);
685 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
687 "Returns the address of the socket that the socket @var{socket} is connected to,\n"
688 "in the same form as the object\n"
689 "returned by @code{accept}. On many systems the address of a socket\n"
690 "in the @code{AF_FILE} namespace cannot be read.")
691 #define FUNC_NAME s_scm_getpeername
695 int addr_size
= MAX_ADDR_SIZE
;
696 char max_addr
[MAX_ADDR_SIZE
];
697 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
699 sock
= SCM_COERCE_OUTPORT (sock
);
700 SCM_VALIDATE_OPFPORT (1,sock
);
701 fd
= SCM_FPORT_FDES (sock
);
702 if (getpeername (fd
, addr
, &addr_size
) == -1)
705 result
= scm_addr_vector (addr
, FUNC_NAME
);
712 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
713 (SCM sock
, SCM buf
, SCM flags
),
714 "Receives data from the socket port @var{socket}. @var{socket} must already\n"
715 "be bound to the address from which data is to be received.\n"
716 "@var{buf} is a string into which\n"
717 "the data will be written. The size of @var{buf} limits the amount of\n"
718 "data which can be received: in the case of packet\n"
719 "protocols, if a packet larger than this limit is encountered then some data\n"
720 "will be irrevocably lost.\n\n"
721 "The optional @var{flags} argument is a value or\n"
722 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
723 "The value returned is the number of bytes read from the socket.\n\n"
724 "Note that the data is read directly from the socket file descriptor:\n"
725 "any unread buffered port data is ignored.")
726 #define FUNC_NAME s_scm_recv
732 SCM_VALIDATE_OPFPORT (1,sock
);
733 SCM_VALIDATE_STRING (2,buf
);
734 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
735 fd
= SCM_FPORT_FDES (sock
);
737 SCM_SYSCALL (rv
= recv (fd
, SCM_STRING_CHARS (buf
), SCM_STRING_LENGTH (buf
), flg
));
741 return SCM_MAKINUM (rv
);
745 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
746 (SCM sock
, SCM message
, SCM flags
),
747 "Transmits the string @var{message} on the socket port @var{socket}. \n"
748 "@var{socket} must already be bound to a destination address. The\n"
749 "value returned is the number of bytes transmitted -- it's possible for\n"
750 "this to be less than the length of @var{message} if the socket is\n"
751 "set to be non-blocking. The optional @var{flags} argument is a value or\n"
752 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
753 "Note that the data is written directly to the socket file descriptor:\n"
754 "any unflushed buffered port data is ignored.")
755 #define FUNC_NAME s_scm_send
761 sock
= SCM_COERCE_OUTPORT (sock
);
762 SCM_VALIDATE_OPFPORT (1,sock
);
763 SCM_VALIDATE_STRING (2, message
);
764 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
765 fd
= SCM_FPORT_FDES (sock
);
767 SCM_SYSCALL (rv
= send (fd
, SCM_STRING_CHARS (message
), SCM_STRING_LENGTH (message
), flg
));
770 return SCM_MAKINUM (rv
);
774 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
775 (SCM sock
, SCM str
, SCM flags
, SCM start
, SCM end
),
776 "Returns data from the socket port @var{socket} and also information about\n"
777 "where the data was received from. @var{socket} must already\n"
778 "be bound to the address from which data is to be received.\n"
779 "@code{str}, is a string into which\n"
780 "the data will be written. The size of @var{str} limits the amount of\n"
781 "data which can be received: in the case of packet\n"
782 "protocols, if a packet larger than this limit is encountered then some data\n"
783 "will be irrevocably lost.\n\n"
784 "The optional @var{flags} argument is a value or\n"
785 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
786 "The value returned is a pair: the CAR is the number of bytes read from\n"
787 "the socket and the CDR an address object in the same form as returned by\n"
789 "The @var{start} and @var{end} arguments specify a substring of @var{str}\n"
790 "to which the data should be written.\n\n"
791 "Note that the data is read directly from the socket file descriptor:\n"
792 "any unread buffered port data is ignored.")
793 #define FUNC_NAME s_scm_recvfrom
802 int addr_size
= MAX_ADDR_SIZE
;
803 char max_addr
[MAX_ADDR_SIZE
];
804 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
806 SCM_VALIDATE_OPFPORT (1,sock
);
807 fd
= SCM_FPORT_FDES (sock
);
808 SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, str
, buf
, 4, start
, offset
,
810 if (SCM_UNBNDP (flags
))
813 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
815 /* recvfrom will not necessarily return an address. e.g., linux
816 2.4.2 doesn't change addr or addr_size if socket is
817 AF_INET/SOCK_STREAM. */
818 addr
->sa_family
= AF_UNSPEC
;
819 SCM_SYSCALL (rv
= recvfrom (fd
, buf
+ offset
,
824 if (addr_size
> 0 && addr
->sa_family
!= AF_UNSPEC
)
825 address
= scm_addr_vector (addr
, FUNC_NAME
);
827 address
= SCM_BOOL_F
;
829 return scm_cons (SCM_MAKINUM (rv
), address
);
833 SCM_DEFINE (scm_sendto
, "sendto", 4, 0, 1,
834 (SCM sock
, SCM message
, SCM fam
, SCM address
, SCM args_and_flags
),
835 "Transmits the string @var{message} on the socket port @var{socket}. The\n"
836 "destination address is specified using the @var{family}, @var{address} and\n"
837 "@var{arg} arguments, in a similar way to the @code{connect}\n"
839 "value returned is the number of bytes transmitted -- it's possible for\n"
840 "this to be less than the length of @var{message} if the socket is\n"
841 "set to be non-blocking. The optional @var{flags} argument is a value or\n"
842 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
843 "Note that the data is written directly to the socket file descriptor:\n"
844 "any unflushed buffered port data is ignored.")
845 #define FUNC_NAME s_scm_sendto
850 struct sockaddr
*soka
;
853 sock
= SCM_COERCE_OUTPORT (sock
);
854 SCM_VALIDATE_FPORT (1,sock
);
855 SCM_VALIDATE_STRING (2, message
);
856 SCM_VALIDATE_INUM (3,fam
);
857 fd
= SCM_FPORT_FDES (sock
);
858 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args_and_flags
, 4,
860 if (SCM_NULLP (args_and_flags
))
864 SCM_VALIDATE_CONS (5,args_and_flags
);
865 flg
= SCM_NUM2ULONG (5,SCM_CAR (args_and_flags
));
867 SCM_SYSCALL (rv
= sendto (fd
, SCM_STRING_CHARS (message
),
868 SCM_STRING_LENGTH (message
),
872 int save_errno
= errno
;
878 return SCM_MAKINUM (rv
);
887 /* protocol families. */
889 scm_sysintern ("AF_UNSPEC", SCM_MAKINUM (AF_UNSPEC
));
892 scm_sysintern ("AF_UNIX", SCM_MAKINUM (AF_UNIX
));
895 scm_sysintern ("AF_INET", SCM_MAKINUM (AF_INET
));
899 scm_sysintern ("PF_UNSPEC", SCM_MAKINUM (PF_UNSPEC
));
902 scm_sysintern ("PF_UNIX", SCM_MAKINUM (PF_UNIX
));
905 scm_sysintern ("PF_INET", SCM_MAKINUM (PF_INET
));
910 scm_sysintern ("SOCK_STREAM", SCM_MAKINUM (SOCK_STREAM
));
913 scm_sysintern ("SOCK_DGRAM", SCM_MAKINUM (SOCK_DGRAM
));
916 scm_sysintern ("SOCK_RAW", SCM_MAKINUM (SOCK_RAW
));
919 /* setsockopt level. */
921 scm_sysintern ("SOL_SOCKET", SCM_MAKINUM (SOL_SOCKET
));
924 scm_sysintern ("SOL_IP", SCM_MAKINUM (SOL_IP
));
927 scm_sysintern ("SOL_TCP", SCM_MAKINUM (SOL_TCP
));
930 scm_sysintern ("SOL_UDP", SCM_MAKINUM (SOL_UDP
));
933 /* setsockopt names. */
935 scm_sysintern ("SO_DEBUG", SCM_MAKINUM (SO_DEBUG
));
938 scm_sysintern ("SO_REUSEADDR", SCM_MAKINUM (SO_REUSEADDR
));
941 scm_sysintern ("SO_STYLE", SCM_MAKINUM (SO_STYLE
));
944 scm_sysintern ("SO_TYPE", SCM_MAKINUM (SO_TYPE
));
947 scm_sysintern ("SO_ERROR", SCM_MAKINUM (SO_ERROR
));
950 scm_sysintern ("SO_DONTROUTE", SCM_MAKINUM (SO_DONTROUTE
));
953 scm_sysintern ("SO_BROADCAST", SCM_MAKINUM (SO_BROADCAST
));
956 scm_sysintern ("SO_SNDBUF", SCM_MAKINUM (SO_SNDBUF
));
959 scm_sysintern ("SO_RCVBUF", SCM_MAKINUM (SO_RCVBUF
));
962 scm_sysintern ("SO_KEEPALIVE", SCM_MAKINUM (SO_KEEPALIVE
));
965 scm_sysintern ("SO_OOBINLINE", SCM_MAKINUM (SO_OOBINLINE
));
968 scm_sysintern ("SO_NO_CHECK", SCM_MAKINUM (SO_NO_CHECK
));
971 scm_sysintern ("SO_PRIORITY", SCM_MAKINUM (SO_PRIORITY
));
974 scm_sysintern ("SO_LINGER", SCM_MAKINUM (SO_LINGER
));
977 /* recv/send options. */
979 scm_sysintern ("MSG_OOB", SCM_MAKINUM (MSG_OOB
));
982 scm_sysintern ("MSG_PEEK", SCM_MAKINUM (MSG_PEEK
));
985 scm_sysintern ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE
));
988 scm_add_feature ("socket");
990 #ifndef SCM_MAGIC_SNARFER
991 #include "libguile/socket.x"