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>
76 SCM_DEFINE (scm_htons
, "htons", 1, 0, 0,
78 "Returns a new integer from @var{value} by converting from host to\n"
79 "network order. @var{value} must be within the range of a C unsigned\n"
81 #define FUNC_NAME s_scm_htons
85 SCM_VALIDATE_INUM_COPY (1,in
,c_in
);
86 if (c_in
!= SCM_INUM (in
))
87 SCM_OUT_OF_RANGE (1,in
);
89 return SCM_MAKINUM (htons (c_in
));
93 SCM_DEFINE (scm_ntohs
, "ntohs", 1, 0, 0,
95 "Returns a new integer from @var{value} by converting from network to\n"
96 "host order. @var{value} must be within the range of a C unsigned short\n"
98 #define FUNC_NAME s_scm_ntohs
102 SCM_VALIDATE_INUM_COPY (1,in
,c_in
);
103 if (c_in
!= SCM_INUM (in
))
104 SCM_OUT_OF_RANGE (1,in
);
106 return SCM_MAKINUM (ntohs (c_in
));
110 SCM_DEFINE (scm_htonl
, "htonl", 1, 0, 0,
112 "Returns a new integer from @var{value} by converting from host to\n"
113 "network order. @var{value} must be within the range of a C unsigned\n"
115 #define FUNC_NAME s_scm_htonl
117 unsigned long c_in
= SCM_NUM2ULONG (1,in
);
118 return scm_ulong2num (htonl (c_in
));
122 SCM_DEFINE (scm_ntohl
, "ntohl", 1, 0, 0,
124 "Returns a new integer from @var{value} by converting from network to\n"
125 "host order. @var{value} must be within the range of a C unsigned\n"
127 #define FUNC_NAME s_scm_ntohl
129 unsigned long c_in
= SCM_NUM2ULONG (1,in
);
130 return scm_ulong2num (ntohl (c_in
));
134 SCM_SYMBOL (sym_socket
, "socket");
137 scm_sock_fd_to_port (int fd
, const char *proc
)
142 result
= scm_fdes_to_port (fd
, "r+0", sym_socket
);
147 #define SCM_SOCK_FD_TO_PORT(fd) (scm_sock_fd_to_port((fd),FUNC_NAME))
149 SCM_DEFINE (scm_socket
, "socket", 3, 0, 0,
150 (SCM family
, SCM style
, SCM proto
),
151 "Returns a new socket port of the type specified by @var{family}, @var{style}\n"
152 "and @var{protocol}. All three parameters are integers. Typical values\n"
153 "for @var{family} are the values of @code{AF_UNIX}\n"
154 "and @code{AF_INET}. Typical values for @var{style} are\n"
155 "the values of @code{SOCK_STREAM}, @code{SOCK_DGRAM} and @code{SOCK_RAW}.\n\n"
156 "@var{protocol} can be obtained from a protocol name using\n"
157 "@code{getprotobyname}. A value of\n"
158 "zero specifies the default protocol, which is usually right.\n\n"
159 "A single socket port cannot by used for communication until\n"
160 "it has been connected to another socket.")
161 #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
));
170 result
= SCM_SOCK_FD_TO_PORT (fd
);
177 #ifdef HAVE_SOCKETPAIR
178 SCM_DEFINE (scm_socketpair
, "socketpair", 3, 0, 0,
179 (SCM family
, SCM style
, SCM proto
),
180 "Returns a pair of connected (but unnamed) socket ports of the type specified\n"
181 "by @var{family}, @var{style} and @var{protocol}.\n"
182 "Many systems support only\n"
183 "socket pairs of the @code{AF_UNIX} family. Zero is likely to be\n"
184 "the only meaningful value for @var{protocol}.")
185 #define FUNC_NAME s_scm_socketpair
192 SCM_VALIDATE_INUM (1,family
);
193 SCM_VALIDATE_INUM (2,style
);
194 SCM_VALIDATE_INUM (3,proto
);
196 fam
= SCM_INUM (family
);
198 if (socketpair (fam
, SCM_INUM (style
), SCM_INUM (proto
), fd
) == -1)
201 a
= SCM_SOCK_FD_TO_PORT(fd
[0]);
202 b
= SCM_SOCK_FD_TO_PORT(fd
[1]);
203 return scm_cons (a
, b
);
208 SCM_DEFINE (scm_getsockopt
, "getsockopt", 3, 0, 0,
209 (SCM sock
, SCM level
, SCM optname
),
210 "Returns the value of a particular socket option for the socket\n"
211 "port @var{socket}. @var{level} is an integer code for type of option\n"
212 "being requested, e.g., @code{SOL_SOCKET} for socket-level options.\n"
213 "@var{optname} is an\n"
214 "integer code for the option required and should be specified using one of\n"
215 "the symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n\n"
216 "The returned value is typically an integer but @code{SO_LINGER} returns a\n"
218 #define FUNC_NAME s_scm_getsockopt
222 #ifdef HAVE_STRUCT_LINGER
223 char optval
[sizeof (struct linger
)];
225 char optval
[sizeof (scm_sizet
)];
230 #ifdef HAVE_STRUCT_LINGER
231 optlen
= sizeof (struct linger
);
233 optlen
= sizeof (size_t);
236 sock
= SCM_COERCE_OUTPORT (sock
);
237 SCM_VALIDATE_OPFPORT (1, sock
);
238 SCM_VALIDATE_INUM_COPY (2, level
, ilevel
);
239 SCM_VALIDATE_INUM_COPY (3, optname
, ioptname
);
241 fd
= SCM_FPORT_FDES (sock
);
242 if (getsockopt (fd
, ilevel
, ioptname
, (void *) optval
, &optlen
) == -1)
246 if (ilevel
== SOL_SOCKET
&& ioptname
== SO_LINGER
)
248 #ifdef HAVE_STRUCT_LINGER
249 struct linger
*ling
= (struct linger
*) optval
;
250 return scm_cons (SCM_MAKINUM (ling
->l_onoff
),
251 SCM_MAKINUM (ling
->l_linger
));
253 scm_sizet
*ling
= (scm_sizet
*) optval
;
254 return scm_cons (SCM_MAKINUM (*ling
),
260 if (ilevel
== SOL_SOCKET
&& ioptname
== SO_SNDBUF
)
262 scm_sizet
*bufsize
= (scm_sizet
*) optval
;
263 return SCM_MAKINUM (*bufsize
);
267 if (ilevel
== SOL_SOCKET
&& ioptname
== SO_RCVBUF
)
269 scm_sizet
*bufsize
= (scm_sizet
*) optval
;
270 return SCM_MAKINUM (*bufsize
);
273 return SCM_MAKINUM (*(int *) optval
);
277 SCM_DEFINE (scm_setsockopt
, "setsockopt", 4, 0, 0,
278 (SCM sock
, SCM level
, SCM optname
, SCM value
),
279 "Sets the value of a particular socket option for the socket\n"
280 "port @var{socket}. @var{level} is an integer code for type of option\n"
281 "being set, e.g., @code{SOL_SOCKET} for socket-level options.\n"
282 "@var{optname} is an\n"
283 "integer code for the option to set and should be specified using one of\n"
284 "the symbols @code{SO_DEBUG}, @code{SO_REUSEADDR} etc.\n"
285 "@var{value} is the value to which the option should be set. For\n"
286 "most options this must be an integer, but for @code{SO_LINGER} it must\n"
288 "The return value is unspecified.")
289 #define FUNC_NAME s_scm_setsockopt
293 #ifdef HAVE_STRUCT_LINGER
294 char optval
[sizeof (struct linger
)]; /* Biggest option :-( */
296 char optval
[sizeof (scm_sizet
)];
298 int ilevel
, ioptname
;
299 sock
= SCM_COERCE_OUTPORT (sock
);
300 SCM_VALIDATE_OPFPORT (1,sock
);
301 SCM_VALIDATE_INUM_COPY (2,level
,ilevel
);
302 SCM_VALIDATE_INUM_COPY (3,optname
,ioptname
);
303 fd
= SCM_FPORT_FDES (sock
);
306 else if (ilevel
== SOL_SOCKET
&& ioptname
== SO_LINGER
)
308 #ifdef HAVE_STRUCT_LINGER
310 SCM_ASSERT (SCM_CONSP (value
)
311 && SCM_INUMP (SCM_CAR (value
))
312 && SCM_INUMP (SCM_CDR (value
)),
313 value
, SCM_ARG4
, FUNC_NAME
);
314 ling
.l_onoff
= SCM_INUM (SCM_CAR (value
));
315 ling
.l_linger
= SCM_INUM (SCM_CDR (value
));
316 optlen
= (int) sizeof (struct linger
);
317 memcpy (optval
, (void *) &ling
, optlen
);
320 SCM_ASSERT (SCM_CONSP (value
)
321 && SCM_INUMP (SCM_CAR (value
))
322 && SCM_INUMP (SCM_CDR (value
)),
323 value
, SCM_ARG4
, FUNC_NAME
);
324 ling
= SCM_INUM (SCM_CAR (value
));
325 optlen
= (int) sizeof (scm_sizet
);
326 (*(scm_sizet
*) optval
) = (scm_sizet
) SCM_INUM (value
);
331 else if (ilevel
== SOL_SOCKET
&& ioptname
== SO_SNDBUF
)
333 SCM_VALIDATE_INUM (4,value
);
334 optlen
= (int) sizeof (scm_sizet
);
335 (*(scm_sizet
*) optval
) = (scm_sizet
) SCM_INUM (value
);
339 else if (ilevel
== SOL_SOCKET
&& ioptname
== SO_RCVBUF
)
341 SCM_VALIDATE_INUM (4,value
);
342 optlen
= (int) sizeof (scm_sizet
);
343 (*(scm_sizet
*) optval
) = (scm_sizet
) SCM_INUM (value
);
348 /* Most options just take an int. */
349 SCM_VALIDATE_INUM (4,value
);
350 optlen
= (int) sizeof (int);
351 (*(int *) optval
) = (int) SCM_INUM (value
);
353 if (setsockopt (fd
, ilevel
, ioptname
, (void *) optval
, optlen
) == -1)
355 return SCM_UNSPECIFIED
;
359 SCM_DEFINE (scm_shutdown
, "shutdown", 2, 0, 0,
361 "Sockets can be closed simply by using @code{close-port}. The\n"
362 "@code{shutdown} procedure allows reception or tranmission on a\n"
363 "connection to be shut down individually, according to the parameter\n"
367 "Stop receiving data for this socket. If further data arrives, reject it.\n"
369 "Stop trying to transmit data from this socket. Discard any\n"
370 "data waiting to be sent. Stop looking for acknowledgement of\n"
371 "data already sent; don't retransmit it if it is lost.\n"
373 "Stop both reception and transmission.\n"
375 "The return value is unspecified.")
376 #define FUNC_NAME s_scm_shutdown
379 sock
= SCM_COERCE_OUTPORT (sock
);
380 SCM_VALIDATE_OPFPORT (1,sock
);
381 SCM_VALIDATE_INUM (2,how
);
382 SCM_ASSERT_RANGE(2,how
,0 <= SCM_INUM (how
) && 2 >= SCM_INUM (how
));
383 fd
= SCM_FPORT_FDES (sock
);
384 if (shutdown (fd
, SCM_INUM (how
)) == -1)
386 return SCM_UNSPECIFIED
;
390 /* convert fam/address/args into a sockaddr of the appropriate type.
391 args is modified by removing the arguments actually used.
392 which_arg and proc are used when reporting errors:
393 which_arg is the position of address in the original argument list.
394 proc is the name of the original procedure.
395 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
,const char *proc
,scm_sizet
*size
)
406 struct sockaddr_in
*soka
;
408 soka
= (struct sockaddr_in
*)
409 scm_must_malloc (sizeof (struct sockaddr_in
), proc
);
410 /* e.g., for BSDs which don't like invalid sin_len. */
411 memset (soka
, 0, sizeof (struct sockaddr_in
));
412 soka
->sin_family
= AF_INET
;
413 soka
->sin_addr
.s_addr
=
414 htonl (scm_num2ulong (address
, (char *) which_arg
, proc
));
415 SCM_ASSERT (SCM_CONSP (*args
), *args
,
416 which_arg
+ 1, proc
);
417 isport
= SCM_CAR (*args
);
418 *args
= SCM_CDR (*args
);
419 SCM_ASSERT (SCM_INUMP (isport
), isport
, which_arg
+ 1, proc
);
420 soka
->sin_port
= htons (SCM_INUM (isport
));
421 *size
= sizeof (struct sockaddr_in
);
422 return (struct sockaddr
*) soka
;
424 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
427 struct sockaddr_un
*soka
;
429 soka
= (struct sockaddr_un
*)
430 scm_must_malloc (sizeof (struct sockaddr_un
), proc
);
431 memset (soka
, 0, sizeof (struct sockaddr_un
));
432 soka
->sun_family
= AF_UNIX
;
433 SCM_ASSERT (SCM_ROSTRINGP (address
), address
,
435 memcpy (soka
->sun_path
, SCM_ROCHARS (address
),
436 1 + SCM_ROLENGTH (address
));
437 *size
= sizeof (struct sockaddr_un
);
438 return (struct sockaddr
*) soka
;
442 scm_out_of_range (proc
, SCM_MAKINUM (fam
));
446 SCM_DEFINE (scm_connect
, "connect", 3, 0, 1,
447 (SCM sock
, SCM fam
, SCM address
, SCM args
),
448 "Initiates a connection from @var{socket} to the address\n"
449 "specified by @var{address} and possibly @var{arg @dots{}}. The format\n"
450 "required for @var{address}\n"
451 "and @var{arg} @dots{} depends on the family of the socket.\n\n"
452 "For a socket of family @code{AF_UNIX},\n"
453 "only @code{address} is specified and must be a string with the\n"
454 "filename where the socket is to be created.\n\n"
455 "For a socket of family @code{AF_INET},\n"
456 "@code{address} must be an integer Internet host address and @var{arg} @dots{}\n"
457 "must be a single integer port number.\n\n"
458 "The return value is unspecified.")
459 #define FUNC_NAME s_scm_connect
462 struct sockaddr
*soka
;
465 sock
= SCM_COERCE_OUTPORT (sock
);
466 SCM_VALIDATE_OPFPORT (1,sock
);
467 SCM_VALIDATE_INUM (2,fam
);
468 fd
= SCM_FPORT_FDES (sock
);
469 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
, &size
);
470 if (connect (fd
, soka
, size
) == -1)
472 scm_must_free ((char *) soka
);
473 return SCM_UNSPECIFIED
;
477 SCM_DEFINE (scm_bind
, "bind", 3, 0, 1,
478 (SCM sock
, SCM fam
, SCM address
, SCM args
),
479 "Assigns an address to the socket port @var{socket}.\n"
480 "Generally this only needs to be done for server sockets,\n"
481 "so they know where to look for incoming connections. A socket\n"
482 "without an address will be assigned one automatically when it\n"
483 "starts communicating.\n\n"
484 "The format of @var{address} and @var{ARG} @dots{} depends on the family\n"
486 "For a socket of family @code{AF_UNIX}, only @var{address}\n"
487 "is specified and must \n"
488 "be a string with the filename where the socket is to be created.\n\n"
489 "For a socket of family @code{AF_INET}, @var{address} must be an integer\n"
490 "Internet host address and @var{arg} @dots{} must be a single integer\n"
492 "The values of the following variables can also be used for @var{address}:\n\n"
493 "@defvar INADDR_ANY\n"
494 "Allow connections from any address.\n"
496 "@defvar INADDR_LOOPBACK\n"
497 "The address of the local host using the loopback device.\n"
499 "@defvar INADDR_BROADCAST\n"
500 "The broadcast address on the local network.\n"
502 "@defvar INADDR_NONE\n"
505 "The return value is unspecified.")
506 #define FUNC_NAME s_scm_bind
509 struct sockaddr
*soka
;
513 sock
= SCM_COERCE_OUTPORT (sock
);
514 SCM_VALIDATE_OPFPORT (1,sock
);
515 SCM_VALIDATE_INUM (2,fam
);
516 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args
, 3, FUNC_NAME
, &size
);
517 fd
= SCM_FPORT_FDES (sock
);
518 rv
= bind (fd
, soka
, size
);
521 scm_must_free ((char *) soka
);
522 return SCM_UNSPECIFIED
;
526 SCM_DEFINE (scm_listen
, "listen", 2, 0, 0,
527 (SCM sock
, SCM backlog
),
528 "This procedure enables @var{socket} to accept connection\n"
529 "requests. @var{backlog} is an integer specifying\n"
530 "the maximum length of the queue for pending connections.\n"
531 "If the queue fills, new clients will fail to connect until the\n"
532 "server calls @code{accept} to accept a connection from the queue.\n\n"
533 "The return value is unspecified.")
534 #define FUNC_NAME s_scm_listen
537 sock
= SCM_COERCE_OUTPORT (sock
);
538 SCM_VALIDATE_OPFPORT (1,sock
);
539 SCM_VALIDATE_INUM (2,backlog
);
540 fd
= SCM_FPORT_FDES (sock
);
541 if (listen (fd
, SCM_INUM (backlog
)) == -1)
543 return SCM_UNSPECIFIED
;
547 /* Put the components of a sockaddr into a new SCM vector. */
550 scm_addr_vector (struct sockaddr
*address
,const char *proc
)
552 short int fam
= address
->sa_family
;
555 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
558 struct sockaddr_un
*nad
= (struct sockaddr_un
*) address
;
559 result
= scm_make_vector (SCM_MAKINUM (2), SCM_UNSPECIFIED
);
560 ve
= SCM_VELTS (result
);
561 ve
[0] = scm_ulong2num ((unsigned long) fam
);
562 ve
[1] = scm_makfromstr (nad
->sun_path
,
563 (scm_sizet
) strlen (nad
->sun_path
), 0);
569 struct sockaddr_in
*nad
= (struct sockaddr_in
*) address
;
570 result
= scm_make_vector (SCM_MAKINUM (3), SCM_UNSPECIFIED
);
571 ve
= SCM_VELTS (result
);
572 ve
[0] = scm_ulong2num ((unsigned long) fam
);
573 ve
[1] = scm_ulong2num (ntohl (nad
->sin_addr
.s_addr
));
574 ve
[2] = scm_ulong2num ((unsigned long) ntohs (nad
->sin_port
));
577 scm_misc_error (proc
, "Unrecognised address family: ~A",
578 scm_listify (SCM_MAKINUM (fam
), SCM_UNDEFINED
));
583 /* Allocate a buffer large enough to hold any sockaddr type. */
584 static char *scm_addr_buffer
;
585 static size_t scm_addr_buffer_size
;
588 scm_init_addr_buffer (void)
590 scm_addr_buffer_size
=
591 #ifdef HAVE_UNIX_DOMAIN_SOCKETS
592 sizeof (struct sockaddr_un
)
597 if (sizeof (struct sockaddr_in
) > scm_addr_buffer_size
)
598 scm_addr_buffer_size
= sizeof (struct sockaddr_in
);
599 scm_addr_buffer
= scm_must_malloc (scm_addr_buffer_size
, "address buffer");
602 SCM_DEFINE (scm_accept
, "accept", 1, 0, 0,
604 "Accepts a connection on a bound, listening socket @var{socket}. If there\n"
605 "are no pending connections in the queue, it waits until\n"
606 "one is available unless the non-blocking option has been set on the\n"
608 "The return value is a\n"
609 "pair in which the CAR is a new socket port for the connection and\n"
610 "the CDR is an object with address information about the client which\n"
611 "initiated the connection.\n\n"
612 "If the address is not available then the CDR will be an empty vector.\n\n"
613 "@var{socket} does not become part of the\n"
614 "connection and will continue to accept new requests.")
615 #define FUNC_NAME s_scm_accept
623 sock
= SCM_COERCE_OUTPORT (sock
);
624 SCM_VALIDATE_OPFPORT (1,sock
);
625 fd
= SCM_FPORT_FDES (sock
);
626 tmp_size
= scm_addr_buffer_size
;
627 newfd
= accept (fd
, (struct sockaddr
*) scm_addr_buffer
, &tmp_size
);
628 newsock
= scm_sock_fd_to_port (newfd
, FUNC_NAME
);
630 address
= scm_addr_vector ((struct sockaddr
*) scm_addr_buffer
, FUNC_NAME
);
632 address
= SCM_BOOL_F
;
634 return scm_cons (newsock
, address
);
638 SCM_DEFINE (scm_getsockname
, "getsockname", 1, 0, 0,
640 "Returns the address of @var{socket}, in the same form as the object\n"
641 "returned by @code{accept}. On many systems the address of a socket\n"
642 "in the @code{AF_FILE} namespace cannot be read.")
643 #define FUNC_NAME s_scm_getsockname
648 sock
= SCM_COERCE_OUTPORT (sock
);
649 SCM_VALIDATE_OPFPORT (1,sock
);
650 fd
= SCM_FPORT_FDES (sock
);
651 tmp_size
= scm_addr_buffer_size
;
652 if (getsockname (fd
, (struct sockaddr
*) scm_addr_buffer
, &tmp_size
) == -1)
655 result
= scm_addr_vector ((struct sockaddr
*) scm_addr_buffer
, FUNC_NAME
);
662 SCM_DEFINE (scm_getpeername
, "getpeername", 1, 0, 0,
664 "Returns the address of the socket that the socket @var{socket} is connected to,\n"
665 "in the same form as the object\n"
666 "returned by @code{accept}. On many systems the address of a socket\n"
667 "in the @code{AF_FILE} namespace cannot be read.")
668 #define FUNC_NAME s_scm_getpeername
673 sock
= SCM_COERCE_OUTPORT (sock
);
674 SCM_VALIDATE_OPFPORT (1,sock
);
675 fd
= SCM_FPORT_FDES (sock
);
676 tmp_size
= scm_addr_buffer_size
;
677 if (getpeername (fd
, (struct sockaddr
*) scm_addr_buffer
, &tmp_size
) == -1)
680 result
= scm_addr_vector ((struct sockaddr
*) scm_addr_buffer
, FUNC_NAME
);
687 SCM_DEFINE (scm_recv
, "recv!", 2, 1, 0,
688 (SCM sock
, SCM buf
, SCM flags
),
689 "Receives data from the socket port @var{socket}. @var{socket} must already\n"
690 "be bound to the address from which data is to be received.\n"
691 "@var{buf} is a string into which\n"
692 "the data will be written. The size of @var{buf} limits the amount of\n"
693 "data which can be received: in the case of packet\n"
694 "protocols, if a packet larger than this limit is encountered then some data\n"
695 "will be irrevocably lost.\n\n"
696 "The optional @var{flags} argument is a value or\n"
697 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
698 "The value returned is the number of bytes read from the socket.\n\n"
699 "Note that the data is read directly from the socket file descriptor:\n"
700 "any unread buffered port data is ignored.")
701 #define FUNC_NAME s_scm_recv
707 SCM_VALIDATE_OPFPORT (1,sock
);
708 SCM_VALIDATE_STRING (2,buf
);
709 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
710 fd
= SCM_FPORT_FDES (sock
);
712 SCM_SYSCALL (rv
= recv (fd
, SCM_STRING_CHARS (buf
), SCM_STRING_LENGTH (buf
), flg
));
716 return SCM_MAKINUM (rv
);
720 SCM_DEFINE (scm_send
, "send", 2, 1, 0,
721 (SCM sock
, SCM message
, SCM flags
),
722 "Transmits the string @var{message} on the socket port @var{socket}. \n"
723 "@var{socket} must already be bound to a destination address. The\n"
724 "value returned is the number of bytes transmitted -- it's possible for\n"
725 "this to be less than the length of @var{message} if the socket is\n"
726 "set to be non-blocking. The optional @var{flags} argument is a value or\n"
727 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
728 "Note that the data is written directly to the socket file descriptor:\n"
729 "any unflushed buffered port data is ignored.")
730 #define FUNC_NAME s_scm_send
736 sock
= SCM_COERCE_OUTPORT (sock
);
737 SCM_VALIDATE_OPFPORT (1,sock
);
738 SCM_VALIDATE_ROSTRING (2,message
);
739 SCM_VALIDATE_INUM_DEF_COPY (3,flags
,0,flg
);
740 fd
= SCM_FPORT_FDES (sock
);
742 SCM_SYSCALL (rv
= send (fd
, SCM_ROCHARS (message
), SCM_ROLENGTH (message
), flg
));
745 return SCM_MAKINUM (rv
);
749 SCM_DEFINE (scm_recvfrom
, "recvfrom!", 2, 3, 0,
750 (SCM sock
, SCM buf
, SCM flags
, SCM start
, SCM end
),
751 "Returns data from the socket port @var{socket} and also information about\n"
752 "where the data was received from. @var{socket} must already\n"
753 "be bound to the address from which data is to be received.\n"
754 "@code{buf}, is a string into which\n"
755 "the data will be written. The size of @var{buf} limits the amount of\n"
756 "data which can be received: in the case of packet\n"
757 "protocols, if a packet larger than this limit is encountered then some data\n"
758 "will be irrevocably lost.\n\n"
759 "The optional @var{flags} argument is a value or\n"
760 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
761 "The value returned is a pair: the CAR is the number of bytes read from\n"
762 "the socket and the CDR an address object in the same form as returned by\n"
764 "The @var{start} and @var{end} arguments specify a substring of @var{buf}\n"
765 "to which the data should be written.\n\n"
766 "Note that the data is read directly from the socket file descriptor:\n"
767 "any unread buffered port data is ignored.")
768 #define FUNC_NAME s_scm_recvfrom
778 SCM_VALIDATE_OPFPORT (1,sock
);
779 SCM_VALIDATE_STRING (2,buf
);
780 cend
= SCM_STRING_LENGTH (buf
);
782 if (SCM_UNBNDP (flags
))
786 flg
= SCM_NUM2ULONG (3,flags
);
788 if (!SCM_UNBNDP (start
))
790 offset
= (int) SCM_NUM2LONG (4,start
);
792 if (offset
< 0 || offset
>= cend
)
793 SCM_OUT_OF_RANGE (4, start
);
795 if (!SCM_UNBNDP (end
))
797 int tend
= (int) SCM_NUM2LONG (5,end
);
799 if (tend
<= offset
|| tend
> cend
)
800 SCM_OUT_OF_RANGE (5, end
);
807 fd
= SCM_FPORT_FDES (sock
);
809 tmp_size
= scm_addr_buffer_size
;
810 SCM_SYSCALL (rv
= recvfrom (fd
, SCM_STRING_CHARS (buf
) + offset
,
812 (struct sockaddr
*) scm_addr_buffer
,
817 address
= scm_addr_vector ((struct sockaddr
*) scm_addr_buffer
, FUNC_NAME
);
819 address
= SCM_BOOL_F
;
821 return scm_cons (SCM_MAKINUM (rv
), address
);
825 SCM_DEFINE (scm_sendto
, "sendto", 4, 0, 1,
826 (SCM sock
, SCM message
, SCM fam
, SCM address
, SCM args_and_flags
),
827 "Transmits the string @var{message} on the socket port @var{socket}. The\n"
828 "destination address is specified using the @var{family}, @var{address} and\n"
829 "@var{arg} arguments, in a similar way to the @code{connect}\n"
831 "value returned is the number of bytes transmitted -- it's possible for\n"
832 "this to be less than the length of @var{message} if the socket is\n"
833 "set to be non-blocking. The optional @var{flags} argument is a value or\n"
834 "bitwise OR of MSG_OOB, MSG_PEEK, MSG_DONTROUTE etc.\n\n"
835 "Note that the data is written directly to the socket file descriptor:\n"
836 "any unflushed buffered port data is ignored.")
837 #define FUNC_NAME s_scm_sendto
842 struct sockaddr
*soka
;
846 sock
= SCM_COERCE_OUTPORT (sock
);
847 SCM_VALIDATE_FPORT (1,sock
);
848 SCM_VALIDATE_ROSTRING (2,message
);
849 SCM_VALIDATE_INUM (3,fam
);
850 fd
= SCM_FPORT_FDES (sock
);
851 soka
= scm_fill_sockaddr (SCM_INUM (fam
), address
, &args_and_flags
, 4,
853 if (SCM_NULLP (args_and_flags
))
857 SCM_VALIDATE_CONS (5,args_and_flags
);
858 flg
= SCM_NUM2ULONG (5,SCM_CAR (args_and_flags
));
860 SCM_SYSCALL (rv
= sendto (fd
, SCM_ROCHARS (message
), SCM_ROLENGTH (message
),
863 scm_must_free ((char *) soka
);
867 return SCM_MAKINUM (rv
);
876 /* protocol families. */
878 scm_sysintern ("AF_UNSPEC", SCM_MAKINUM (AF_UNSPEC
));
881 scm_sysintern ("AF_UNIX", SCM_MAKINUM (AF_UNIX
));
884 scm_sysintern ("AF_INET", SCM_MAKINUM (AF_INET
));
888 scm_sysintern ("PF_UNSPEC", SCM_MAKINUM (PF_UNSPEC
));
891 scm_sysintern ("PF_UNIX", SCM_MAKINUM (PF_UNIX
));
894 scm_sysintern ("PF_INET", SCM_MAKINUM (PF_INET
));
899 scm_sysintern ("SOCK_STREAM", SCM_MAKINUM (SOCK_STREAM
));
902 scm_sysintern ("SOCK_DGRAM", SCM_MAKINUM (SOCK_DGRAM
));
905 scm_sysintern ("SOCK_RAW", SCM_MAKINUM (SOCK_RAW
));
908 /* setsockopt level. */
910 scm_sysintern ("SOL_SOCKET", SCM_MAKINUM (SOL_SOCKET
));
913 scm_sysintern ("SOL_IP", SCM_MAKINUM (SOL_IP
));
916 scm_sysintern ("SOL_TCP", SCM_MAKINUM (SOL_TCP
));
919 scm_sysintern ("SOL_UDP", SCM_MAKINUM (SOL_UDP
));
922 /* setsockopt names. */
924 scm_sysintern ("SO_DEBUG", SCM_MAKINUM (SO_DEBUG
));
927 scm_sysintern ("SO_REUSEADDR", SCM_MAKINUM (SO_REUSEADDR
));
930 scm_sysintern ("SO_STYLE", SCM_MAKINUM (SO_STYLE
));
933 scm_sysintern ("SO_TYPE", SCM_MAKINUM (SO_TYPE
));
936 scm_sysintern ("SO_ERROR", SCM_MAKINUM (SO_ERROR
));
939 scm_sysintern ("SO_DONTROUTE", SCM_MAKINUM (SO_DONTROUTE
));
942 scm_sysintern ("SO_BROADCAST", SCM_MAKINUM (SO_BROADCAST
));
945 scm_sysintern ("SO_SNDBUF", SCM_MAKINUM (SO_SNDBUF
));
948 scm_sysintern ("SO_RCVBUF", SCM_MAKINUM (SO_RCVBUF
));
951 scm_sysintern ("SO_KEEPALIVE", SCM_MAKINUM (SO_KEEPALIVE
));
954 scm_sysintern ("SO_OOBINLINE", SCM_MAKINUM (SO_OOBINLINE
));
957 scm_sysintern ("SO_NO_CHECK", SCM_MAKINUM (SO_NO_CHECK
));
960 scm_sysintern ("SO_PRIORITY", SCM_MAKINUM (SO_PRIORITY
));
963 scm_sysintern ("SO_LINGER", SCM_MAKINUM (SO_LINGER
));
966 /* recv/send options. */
968 scm_sysintern ("MSG_OOB", SCM_MAKINUM (MSG_OOB
));
971 scm_sysintern ("MSG_PEEK", SCM_MAKINUM (MSG_PEEK
));
974 scm_sysintern ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE
));
977 scm_add_feature ("socket");
978 scm_init_addr_buffer ();
980 #include "libguile/socket.x"