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 "Returns a new integer from @var{value} by converting from host to\n"
88 "network order. @var{value} must be within the range of a C unsigned\n"
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 "Returns a new integer from @var{value} by converting from network to\n"
105 "host order. @var{value} must be within the range of a C unsigned short\n"
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 "Returns a new integer from @var{value} by converting from host to\n"
122 "network order. @var{value} must be within the range of a C unsigned\n"
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 "Returns a new integer from @var{value} by converting from network to\n"
134 "host order. @var{value} must be within the range of a C unsigned\n"
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 "Returns a new socket port of the type specified by @var{family}, @var{style}\n"
150 "and @var{protocol}. All three parameters are integers. Typical values\n"
151 "for @var{family} are the values of @code{AF_UNIX}\n"
152 "and @code{AF_INET}. Typical values for @var{style} are\n"
153 "the values of @code{SOCK_STREAM}, @code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
154 "@var{protocol} can be obtained from a protocol name using\n"
155 "@code{getprotobyname}. A value of\n"
156 "zero specifies the default protocol, which is usually right.\n\n"
157 "A single socket port cannot by used for communication until\n"
158 "it has been connected to another socket.")
159 #define FUNC_NAME s_scm_socket
163 SCM_VALIDATE_INUM (1, family
);
164 SCM_VALIDATE_INUM (2, style
);
165 SCM_VALIDATE_INUM (3, proto
);
166 fd
= socket (SCM_INUM (family
), SCM_INUM (style
), SCM_INUM (proto
));
169 return SCM_SOCK_FD_TO_PORT (fd
);
173 #ifdef HAVE_SOCKETPAIR
174 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
175 (SCM family
, SCM style
, SCM proto
),
176 "Returns a pair of connected (but unnamed) socket ports of the type specified\n"
177 "by @var{family}, @var{style} and @var{protocol}.\n"
178 "Many systems support only\n"
179 "socket pairs of the @code{AF_UNIX} family. Zero is likely to be\n"
180 "the only meaningful value for @var{protocol}.")
181 #define FUNC_NAME s_scm_socketpair
186 SCM_VALIDATE_INUM (1,family
);
187 SCM_VALIDATE_INUM (2,style
);
188 SCM_VALIDATE_INUM (3,proto
);
190 fam
= SCM_INUM (family
);
192 if (socketpair (fam
, SCM_INUM (style
), SCM_INUM (proto
), fd
) == -1)
195 return scm_cons (SCM_SOCK_FD_TO_PORT (fd
[0]), SCM_SOCK_FD_TO_PORT (fd
[1]));
200 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
201 (SCM sock
, SCM level
, SCM optname
),
202 "Returns the value of a particular socket option for the socket\n"
203 "port @var{socket}. @var{level} is an integer code for type of option\n"
204 "being requested, e.g., @code{SOL_SOCKET} for socket-level options.\n"
205 "@var{optname} is an\n"
206 "integer code for the option required and should be specified using one of\n"
207 "the symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n\n"
208 "The returned value is typically an integer but @code{SO_LINGER} returns a\n"
210 #define FUNC_NAME s_scm_getsockopt
213 /* size of optval is the largest supported option. */
214 #ifdef HAVE_STRUCT_LINGER
215 char optval
[sizeof (struct linger
)];
216 int optlen
= sizeof (struct linger
);
218 char optval
[sizeof (scm_sizet
)];
219 int optlen
= sizeof (scm_sizet
);
224 sock
= SCM_COERCE_OUTPORT (sock
);
225 SCM_VALIDATE_OPFPORT (1, sock
);
226 SCM_VALIDATE_INUM_COPY (2, level
, ilevel
);
227 SCM_VALIDATE_INUM_COPY (3, optname
, ioptname
);
229 fd
= SCM_FPORT_FDES (sock
);
230 if (getsockopt (fd
, ilevel
, ioptname
, (void *) optval
, &optlen
) == -1)
233 if (ilevel
== SOL_SOCKET
)
236 if (ioptname
== SO_LINGER
)
238 #ifdef HAVE_STRUCT_LINGER
239 struct linger
*ling
= (struct linger
*) optval
;
241 return scm_cons (scm_long2num (ling
->l_onoff
),
242 scm_long2num (ling
->l_linger
));
244 return scm_cons (scm_long2num (*(int *) optval
)
252 || ioptname
== SO_SNDBUF
255 || ioptname
== SO_RCVBUF
259 return scm_long2num (*(scm_sizet
*) optval
);
262 return scm_long2num (*(int *) optval
);
266 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
267 (SCM sock
, SCM level
, SCM optname
, SCM value
),
268 "Sets the value of a particular socket option for the socket\n"
269 "port @var{socket}. @var{level} is an integer code for type of option\n"
270 "being set, e.g., @code{SOL_SOCKET} for socket-level options.\n"
271 "@var{optname} is an\n"
272 "integer code for the option to set and should be specified using one of\n"
273 "the symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n"
274 "@var{value} is the value to which the option should be set. For\n"
275 "most options this must be an integer, but for @code{SO_LINGER} it must\n"
277 "The return value is unspecified.")
278 #define FUNC_NAME s_scm_setsockopt
282 /* size of optval is the largest supported option. */
283 #ifdef HAVE_STRUCT_LINGER
284 char optval
[sizeof (struct linger
)];
286 char optval
[sizeof (scm_sizet
)];
288 int ilevel
, ioptname
;
290 sock
= SCM_COERCE_OUTPORT (sock
);
292 SCM_VALIDATE_OPFPORT (1, sock
);
293 SCM_VALIDATE_INUM_COPY (2, level
, ilevel
);
294 SCM_VALIDATE_INUM_COPY (3, optname
, ioptname
);
296 fd
= SCM_FPORT_FDES (sock
);
298 if (ilevel
== SOL_SOCKET
)
301 if (ioptname
== SO_LINGER
)
303 #ifdef HAVE_STRUCT_LINGER
307 SCM_ASSERT (SCM_CONSP (value
), value
, SCM_ARG4
, FUNC_NAME
);
308 lv
= SCM_NUM2LONG (4, SCM_CAR (value
));
309 ling
.l_onoff
= (int) lv
;
310 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
.l_onoff
== lv
);
311 lv
= SCM_NUM2LONG (4, SCM_CDR (value
));
312 ling
.l_linger
= (int) lv
;
313 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
.l_linger
== lv
);
314 optlen
= (int) sizeof (struct linger
);
315 memcpy (optval
, (void *) &ling
, optlen
);
320 SCM_ASSERT (SCM_CONSP (value
), value
, SCM_ARG4
, FUNC_NAME
);
321 /* timeout is ignored, but may as well validate it. */
322 lv
= SCM_NUM2LONG (4, SCM_CDR (value
));
324 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
== lv
);
325 lv
= SCM_NUM2LONG (4, SCM_CAR (value
));
327 SCM_ASSERT_RANGE (SCM_ARG4
, value
, ling
== lv
);
328 optlen
= (int) sizeof (int);
329 (*(int *) optval
) = ling
;
336 || ioptname
== SO_SNDBUF
339 || ioptname
== SO_RCVBUF
343 long lv
= SCM_NUM2LONG (4, value
);
345 optlen
= (int) sizeof (scm_sizet
);
346 (*(scm_sizet
*) optval
) = (scm_sizet
) lv
;
351 /* Most options take an int. */
352 long lv
= SCM_NUM2LONG (4, value
);
355 SCM_ASSERT_RANGE (SCM_ARG4
, value
, val
== lv
);
356 optlen
= (int) sizeof (int);
357 (*(int *) optval
) = val
;
359 if (setsockopt (fd
, ilevel
, ioptname
, (void *) optval
, optlen
) == -1)
361 return SCM_UNSPECIFIED
;
365 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
367 "Sockets can be closed simply by using @code{close-port}. The\n"
368 "@code{shutdown} procedure allows reception or tranmission on a\n"
369 "connection to be shut down individually, according to the parameter\n"
373 "Stop receiving data for this socket. If further data arrives, reject it.\n"
375 "Stop trying to transmit data from this socket. Discard any\n"
376 "data waiting to be sent. Stop looking for acknowledgement of\n"
377 "data already sent; don't retransmit it if it is lost.\n"
379 "Stop both reception and transmission.\n"
381 "The return value is unspecified.")
382 #define FUNC_NAME s_scm_shutdown
385 sock
= SCM_COERCE_OUTPORT (sock
);
386 SCM_VALIDATE_OPFPORT (1,sock
);
387 SCM_VALIDATE_INUM (2,how
);
388 SCM_ASSERT_RANGE(2,how
,0 <= SCM_INUM (how
) && 2 >= SCM_INUM (how
));
389 fd
= SCM_FPORT_FDES (sock
);
390 if (shutdown (fd
, SCM_INUM (how
)) == -1)
392 return SCM_UNSPECIFIED
;
396 /* convert fam/address/args into a sockaddr of the appropriate type.
397 args is modified by removing the arguments actually used.
398 which_arg and proc are used when reporting errors:
399 which_arg is the position of address in the original argument list.
400 proc is the name of the original procedure.
401 size returns the size of the structure allocated. */
403 static struct sockaddr
*
404 scm_fill_sockaddr (int fam
, SCM address
, SCM
*args
, int which_arg
,
405 const char *proc
, int *size
)
412 struct sockaddr_in
*soka
;
414 SCM_ASSERT (SCM_CONSP (*args
), *args
,
415 which_arg
+ 1, proc
);
416 isport
= SCM_CAR (*args
);
417 SCM_ASSERT (SCM_INUMP (isport
), isport
, which_arg
+ 1, proc
);
418 soka
= (struct sockaddr_in
*) malloc (sizeof (struct sockaddr_in
));
420 scm_memory_error (proc
);
421 /* e.g., for BSDs which don't like invalid sin_len. */
422 memset (soka
, 0, sizeof (struct sockaddr_in
));
423 soka
->sin_family
= AF_INET
;
424 soka
->sin_addr
.s_addr
=
425 htonl (scm_num2ulong (address
, (char *) which_arg
, proc
));
426 *args
= SCM_CDR (*args
);
427 soka
->sin_port
= htons (SCM_INUM (isport
));
428 *size
= sizeof (struct sockaddr_in
);
429 return (struct sockaddr
*) soka
;
431 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
434 struct sockaddr_un
*soka
;
437 SCM_ASSERT (SCM_STRINGP (address
), address
, which_arg
, proc
);
438 /* the static buffer size in sockaddr_un seems to be arbitrary
439 and not necessarily a hard limit. e.g., the glibc manual
440 suggests it may be possible to declare it size 0. let's
441 ignore it. if the O/S doesn't like the size it will cause
442 connect/bind etc., to fail. sun_path is always the last
443 member of the structure. */
444 addr_size
= sizeof (struct sockaddr_un
)
445 + max (0, SCM_STRING_LENGTH (address
) + 1 - (sizeof soka
->sun_path
));
446 soka
= (struct sockaddr_un
*) malloc (addr_size
);
448 scm_memory_error (proc
);
449 memset (soka
, 0, addr_size
); /* for sun_len: see sin_len above. */
450 soka
->sun_family
= AF_UNIX
;
451 memcpy (soka
->sun_path
, SCM_STRING_CHARS (address
),
452 SCM_STRING_LENGTH (address
));
453 *size
= SUN_LEN (soka
);
454 return (struct sockaddr
*) soka
;
458 scm_out_of_range (proc
, SCM_MAKINUM (fam
));
462 SCM_DEFINE (scm_connect
, "connect", 3, 0, 1,
463 (SCM sock
, SCM fam
, SCM address
, SCM args
),
464 "Initiates a connection from @var{socket} to the address\n"
465 "specified by @var{address} and possibly @var{arg @dots{}}. The format\n"
466 "required for @var{address}\n"
467 "and @var{arg} @dots{} depends on the family of the socket.\n\n"
468 "For a socket of family @code{AF_UNIX},\n"
469 "only @code{address} is specified and must be a string with the\n"
470 "filename where the socket is to be created.\n\n"
471 "For a socket of family @code{AF_INET},\n"
472 "@code{address} must be an integer Internet host address and @var{arg} @dots{}\n"
473 "must be a single integer port number.\n\n"
474 "The return value is unspecified.")
475 #define FUNC_NAME s_scm_connect
478 struct sockaddr
*soka
;
481 sock
= SCM_COERCE_OUTPORT (sock
);
482 SCM_VALIDATE_OPFPORT (1,sock
);
483 SCM_VALIDATE_INUM (2,fam
);
484 fd
= SCM_FPORT_FDES (sock
);
485 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
487 if (connect (fd
, soka
, size
) == -1)
489 int save_errno
= errno
;
496 return SCM_UNSPECIFIED
;
500 SCM_DEFINE (scm_bind
, "bind", 3, 0, 1,
501 (SCM sock
, SCM fam
, SCM address
, SCM args
),
502 "Assigns an address to the socket port @var{socket}.\n"
503 "Generally this only needs to be done for server sockets,\n"
504 "so they know where to look for incoming connections. A socket\n"
505 "without an address will be assigned one automatically when it\n"
506 "starts communicating.\n\n"
507 "The format of @var{address} and @var{ARG} @dots{} depends on the family\n"
509 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
510 "is specified and must \n"
511 "be a string with the filename where the socket is to be created.\n\n"
512 "For a socket of family @code{AF_INET}, @var{address} must be an integer\n"
513 "Internet host address and @var{arg} @dots{} must be a single integer\n"
515 "The values of the following variables can also be used for @var{address}:\n\n"
516 "@defvar INADDR_ANY\n"
517 "Allow connections from any address.\n"
519 "@defvar INADDR_LOOPBACK\n"
520 "The address of the local host using the loopback device.\n"
522 "@defvar INADDR_BROADCAST\n"
523 "The broadcast address on the local network.\n"
525 "@defvar INADDR_NONE\n"
528 "The return value is unspecified.")
529 #define FUNC_NAME s_scm_bind
531 struct sockaddr
*soka
;
535 sock
= SCM_COERCE_OUTPORT (sock
);
536 SCM_VALIDATE_OPFPORT (1, sock
);
537 SCM_VALIDATE_INUM (2, fam
);
538 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
,
540 fd
= SCM_FPORT_FDES (sock
);
541 if (bind (fd
, soka
, size
) == -1)
543 int save_errno
= errno
;
550 return SCM_UNSPECIFIED
;
554 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
555 (SCM sock
, SCM backlog
),
556 "This procedure enables @var{socket} to accept connection\n"
557 "requests. @var{backlog} is an integer specifying\n"
558 "the maximum length of the queue for pending connections.\n"
559 "If the queue fills, new clients will fail to connect until the\n"
560 "server calls @code{accept} to accept a connection from the queue.\n\n"
561 "The return value is unspecified.")
562 #define FUNC_NAME s_scm_listen
565 sock
= SCM_COERCE_OUTPORT (sock
);
566 SCM_VALIDATE_OPFPORT (1,sock
);
567 SCM_VALIDATE_INUM (2,backlog
);
568 fd
= SCM_FPORT_FDES (sock
);
569 if (listen (fd
, SCM_INUM (backlog
)) == -1)
571 return SCM_UNSPECIFIED
;
575 /* Put the components of a sockaddr into a new SCM vector. */
577 scm_addr_vector (struct sockaddr
*address
, const char *proc
)
579 short int fam
= address
->sa_family
;
583 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
586 struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
588 result
= scm_c_make_vector (2, SCM_UNSPECIFIED
);
589 ve
= SCM_VELTS (result
);
590 ve
[0] = scm_ulong2num ((unsigned long) fam
);
591 ve
[1] = scm_makfromstr (nad
->sun_path
,
592 (scm_sizet
) strlen (nad
->sun_path
), 0);
598 struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
600 result
= scm_c_make_vector (3, SCM_UNSPECIFIED
);
601 ve
= SCM_VELTS (result
);
602 ve
[0] = scm_ulong2num ((unsigned long) fam
);
603 ve
[1] = scm_ulong2num (ntohl (nad
->sin_addr
.s_addr
));
604 ve
[2] = scm_ulong2num ((unsigned long) ntohs (nad
->sin_port
));
607 scm_misc_error (proc
, "Unrecognised address family: ~A",
608 SCM_LIST1 (SCM_MAKINUM (fam
)));
613 /* calculate the size of a buffer large enough to hold any supported
614 sockaddr type. if the buffer isn't large enough, certain system
615 calls will return a truncated address. */
617 #if defined (HAVE_UNIX_DOMAIN_SOCKETS)
618 #define MAX_SIZE_UN sizeof (struct sockaddr_un)
620 #define MAX_SIZE_UN 0
623 #define MAX_ADDR_SIZE max (sizeof (struct sockaddr_in), MAX_SIZE_UN)
625 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
627 "Accepts a connection on a bound, listening socket @var{socket}. If there\n"
628 "are no pending connections in the queue, it waits until\n"
629 "one is available unless the non-blocking option has been set on the\n"
631 "The return value is a\n"
632 "pair in which the CAR is a new socket port for the connection and\n"
633 "the CDR is an object with address information about the client which\n"
634 "initiated the connection.\n\n"
635 "If the address is not available then the CDR will be an empty vector.\n\n"
636 "@var{socket} does not become part of the\n"
637 "connection and will continue to accept new requests.")
638 #define FUNC_NAME s_scm_accept
644 int addr_size
= MAX_ADDR_SIZE
;
645 char max_addr
[MAX_ADDR_SIZE
];
646 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
648 sock
= SCM_COERCE_OUTPORT (sock
);
649 SCM_VALIDATE_OPFPORT (1, sock
);
650 fd
= SCM_FPORT_FDES (sock
);
651 newfd
= accept (fd
, addr
, &addr_size
);
654 newsock
= SCM_SOCK_FD_TO_PORT (newfd
);
656 address
= scm_addr_vector (addr
, FUNC_NAME
);
658 address
= SCM_BOOL_F
;
660 return scm_cons (newsock
, address
);
664 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
666 "Returns the address of @var{socket}, in the same form as the object\n"
667 "returned by @code{accept}. On many systems the address of a socket\n"
668 "in the @code{AF_FILE} namespace cannot be read.")
669 #define FUNC_NAME s_scm_getsockname
673 int addr_size
= MAX_ADDR_SIZE
;
674 char max_addr
[MAX_ADDR_SIZE
];
675 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
677 sock
= SCM_COERCE_OUTPORT (sock
);
678 SCM_VALIDATE_OPFPORT (1,sock
);
679 fd
= SCM_FPORT_FDES (sock
);
680 if (getsockname (fd
, addr
, &addr_size
) == -1)
683 result
= scm_addr_vector (addr
, FUNC_NAME
);
690 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
692 "Returns the address of the socket that the socket @var{socket} is connected to,\n"
693 "in the same form as the object\n"
694 "returned by @code{accept}. On many systems the address of a socket\n"
695 "in the @code{AF_FILE} namespace cannot be read.")
696 #define FUNC_NAME s_scm_getpeername
700 int addr_size
= MAX_ADDR_SIZE
;
701 char max_addr
[MAX_ADDR_SIZE
];
702 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
704 sock
= SCM_COERCE_OUTPORT (sock
);
705 SCM_VALIDATE_OPFPORT (1,sock
);
706 fd
= SCM_FPORT_FDES (sock
);
707 if (getpeername (fd
, addr
, &addr_size
) == -1)
710 result
= scm_addr_vector (addr
, FUNC_NAME
);
717 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
718 (SCM sock
, SCM buf
, SCM flags
),
719 "Receives data from the socket port @var{socket}. @var{socket} must already\n"
720 "be bound to the address from which data is to be received.\n"
721 "@var{buf} is a string into which\n"
722 "the data will be written. The size of @var{buf} limits the amount of\n"
723 "data which can be received: in the case of packet\n"
724 "protocols, if a packet larger than this limit is encountered then some data\n"
725 "will be irrevocably lost.\n\n"
726 "The optional @var{flags} argument is a value or\n"
727 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
728 "The value returned is the number of bytes read from the socket.\n\n"
729 "Note that the data is read directly from the socket file descriptor:\n"
730 "any unread buffered port data is ignored.")
731 #define FUNC_NAME s_scm_recv
737 SCM_VALIDATE_OPFPORT (1,sock
);
738 SCM_VALIDATE_STRING (2,buf
);
739 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
740 fd
= SCM_FPORT_FDES (sock
);
742 SCM_SYSCALL (rv
= recv (fd
, SCM_STRING_CHARS (buf
), SCM_STRING_LENGTH (buf
), flg
));
746 return SCM_MAKINUM (rv
);
750 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
751 (SCM sock
, SCM message
, SCM flags
),
752 "Transmits the string @var{message} on the socket port @var{socket}. \n"
753 "@var{socket} must already be bound to a destination address. The\n"
754 "value returned is the number of bytes transmitted -- it's possible for\n"
755 "this to be less than the length of @var{message} if the socket is\n"
756 "set to be non-blocking. The optional @var{flags} argument is a value or\n"
757 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
758 "Note that the data is written directly to the socket file descriptor:\n"
759 "any unflushed buffered port data is ignored.")
760 #define FUNC_NAME s_scm_send
766 sock
= SCM_COERCE_OUTPORT (sock
);
767 SCM_VALIDATE_OPFPORT (1,sock
);
768 SCM_VALIDATE_STRING (2, message
);
769 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
770 fd
= SCM_FPORT_FDES (sock
);
772 SCM_SYSCALL (rv
= send (fd
, SCM_STRING_CHARS (message
), SCM_STRING_LENGTH (message
), flg
));
775 return SCM_MAKINUM (rv
);
779 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
780 (SCM sock
, SCM str
, SCM flags
, SCM start
, SCM end
),
781 "Returns data from the socket port @var{socket} and also information about\n"
782 "where the data was received from. @var{socket} must already\n"
783 "be bound to the address from which data is to be received.\n"
784 "@code{str}, is a string into which\n"
785 "the data will be written. The size of @var{str} limits the amount of\n"
786 "data which can be received: in the case of packet\n"
787 "protocols, if a packet larger than this limit is encountered then some data\n"
788 "will be irrevocably lost.\n\n"
789 "The optional @var{flags} argument is a value or\n"
790 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
791 "The value returned is a pair: the CAR is the number of bytes read from\n"
792 "the socket and the CDR an address object in the same form as returned by\n"
794 "The @var{start} and @var{end} arguments specify a substring of @var{str}\n"
795 "to which the data should be written.\n\n"
796 "Note that the data is read directly from the socket file descriptor:\n"
797 "any unread buffered port data is ignored.")
798 #define FUNC_NAME s_scm_recvfrom
807 int addr_size
= MAX_ADDR_SIZE
;
808 char max_addr
[MAX_ADDR_SIZE
];
809 struct sockaddr
*addr
= (struct sockaddr
*) max_addr
;
811 SCM_VALIDATE_OPFPORT (1,sock
);
812 fd
= SCM_FPORT_FDES (sock
);
813 SCM_VALIDATE_SUBSTRING_SPEC_COPY (2, str
, buf
, 4, start
, offset
,
815 if (SCM_UNBNDP (flags
))
818 SCM_VALIDATE_ULONG_COPY (3, flags
, flg
);
820 /* recvfrom will not necessarily return an address. usually nothing
821 is returned for stream sockets. */
822 addr
->sa_family
= AF_UNSPEC
;
823 SCM_SYSCALL (rv
= recvfrom (fd
, buf
+ offset
,
828 if (addr_size
> 0 && addr
->sa_family
!= AF_UNSPEC
)
829 address
= scm_addr_vector (addr
, FUNC_NAME
);
831 address
= SCM_BOOL_F
;
833 return scm_cons (SCM_MAKINUM (rv
), address
);
837 SCM_DEFINE (scm_sendto
, "sendto", 4, 0, 1,
838 (SCM sock
, SCM message
, SCM fam
, SCM address
, SCM args_and_flags
),
839 "Transmits the string @var{message} on the socket port @var{socket}. The\n"
840 "destination address is specified using the @var{family}, @var{address} and\n"
841 "@var{arg} arguments, in a similar way to the @code{connect}\n"
843 "value returned is the number of bytes transmitted -- it's possible for\n"
844 "this to be less than the length of @var{message} if the socket is\n"
845 "set to be non-blocking. The optional @var{flags} argument is a value or\n"
846 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
847 "Note that the data is written directly to the socket file descriptor:\n"
848 "any unflushed buffered port data is ignored.")
849 #define FUNC_NAME s_scm_sendto
854 struct sockaddr
*soka
;
857 sock
= SCM_COERCE_OUTPORT (sock
);
858 SCM_VALIDATE_FPORT (1,sock
);
859 SCM_VALIDATE_STRING (2, message
);
860 SCM_VALIDATE_INUM (3,fam
);
861 fd
= SCM_FPORT_FDES (sock
);
862 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args_and_flags
, 4,
864 if (SCM_NULLP (args_and_flags
))
868 SCM_VALIDATE_CONS (5,args_and_flags
);
869 flg
= SCM_NUM2ULONG (5,SCM_CAR (args_and_flags
));
871 SCM_SYSCALL (rv
= sendto (fd
, SCM_STRING_CHARS (message
),
872 SCM_STRING_LENGTH (message
),
876 int save_errno
= errno
;
882 return SCM_MAKINUM (rv
);
891 /* protocol families. */
893 scm_sysintern ("AF_UNSPEC", SCM_MAKINUM (AF_UNSPEC
));
896 scm_sysintern ("AF_UNIX", SCM_MAKINUM (AF_UNIX
));
899 scm_sysintern ("AF_INET", SCM_MAKINUM (AF_INET
));
903 scm_sysintern ("PF_UNSPEC", SCM_MAKINUM (PF_UNSPEC
));
906 scm_sysintern ("PF_UNIX", SCM_MAKINUM (PF_UNIX
));
909 scm_sysintern ("PF_INET", SCM_MAKINUM (PF_INET
));
914 scm_sysintern ("SOCK_STREAM", SCM_MAKINUM (SOCK_STREAM
));
917 scm_sysintern ("SOCK_DGRAM", SCM_MAKINUM (SOCK_DGRAM
));
920 scm_sysintern ("SOCK_RAW", SCM_MAKINUM (SOCK_RAW
));
923 /* setsockopt level. */
925 scm_sysintern ("SOL_SOCKET", SCM_MAKINUM (SOL_SOCKET
));
928 scm_sysintern ("SOL_IP", SCM_MAKINUM (SOL_IP
));
931 scm_sysintern ("SOL_TCP", SCM_MAKINUM (SOL_TCP
));
934 scm_sysintern ("SOL_UDP", SCM_MAKINUM (SOL_UDP
));
937 /* setsockopt names. */
939 scm_sysintern ("SO_DEBUG", SCM_MAKINUM (SO_DEBUG
));
942 scm_sysintern ("SO_REUSEADDR", SCM_MAKINUM (SO_REUSEADDR
));
945 scm_sysintern ("SO_STYLE", SCM_MAKINUM (SO_STYLE
));
948 scm_sysintern ("SO_TYPE", SCM_MAKINUM (SO_TYPE
));
951 scm_sysintern ("SO_ERROR", SCM_MAKINUM (SO_ERROR
));
954 scm_sysintern ("SO_DONTROUTE", SCM_MAKINUM (SO_DONTROUTE
));
957 scm_sysintern ("SO_BROADCAST", SCM_MAKINUM (SO_BROADCAST
));
960 scm_sysintern ("SO_SNDBUF", SCM_MAKINUM (SO_SNDBUF
));
963 scm_sysintern ("SO_RCVBUF", SCM_MAKINUM (SO_RCVBUF
));
966 scm_sysintern ("SO_KEEPALIVE", SCM_MAKINUM (SO_KEEPALIVE
));
969 scm_sysintern ("SO_OOBINLINE", SCM_MAKINUM (SO_OOBINLINE
));
972 scm_sysintern ("SO_NO_CHECK", SCM_MAKINUM (SO_NO_CHECK
));
975 scm_sysintern ("SO_PRIORITY", SCM_MAKINUM (SO_PRIORITY
));
978 scm_sysintern ("SO_LINGER", SCM_MAKINUM (SO_LINGER
));
981 /* recv/send options. */
983 scm_sysintern ("MSG_OOB", SCM_MAKINUM (MSG_OOB
));
986 scm_sysintern ("MSG_PEEK", SCM_MAKINUM (MSG_PEEK
));
989 scm_sysintern ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE
));
992 scm_add_feature ("socket");
994 #ifndef SCM_MAGIC_SNARFER
995 #include "libguile/socket.x"