diff options
author | Gary Houston <ghouston@arglist.com> | 1996-12-21 04:13:54 +0000 |
---|---|---|
committer | Gary Houston <ghouston@arglist.com> | 1996-12-21 04:13:54 +0000 |
commit | 370312ae6e74756a825f3eeed0e227c568142f16 (patch) | |
tree | ddb2b3a1ebc2890aa25237d7b52b7517508e4f0c /libguile/socket.c | |
parent | 80df313695809d4a8fcd96ad6b2e2269b016db26 (diff) | |
download | guile-370312ae6e74756a825f3eeed0e227c568142f16.tar.gz |
* filesys.c (scm_input_waiting_p): use select in preference to
FIONREAD, since the latter doesn't detect EOF.
Throw error if neither select nor FIONREAD available.
* socket.c (scm_connect): take a port, not a fd object.
(scm_fill_sockaddr): throw an error if fam is not recognised.
(scm_bind): use scm_fill_sockaddr.
(scm_listen): take a port, not a fd object.
(scm_accept): take and return a port. return CDR in the car if
address can't be got
(scm_sock_fd_to_port): new procedure.
(scm_socket): use scm_sock_fd_to_port.
(scm_addr_vector): throw error if unrecognised address type.
take an extra argument with the calling procedure name.
(scm_getsockname): take a port. return #f if address can't be got.
(scm_getpeername): take a port. return #f if address can't be got.
(scm_recvfrom): take a port. return #f for address component if can't
be got.
(scm_sendto, scm_socketpair, scm_getsockopt scm_shutdown,
scm_setsockopt, scm_recv, scm_send): take a port not a fd object.
* socket.h (SCM_P): update bind prototype.
* socket.c (scm_init_socket): intern PF_UNSPEC, PF_UNIX, PF_INET.
include "feature.h".
(scm_socket): return a port, not a file descriptor object.
include "fports.h" and <unistd.h>
(scm_bind): take a port, not a file descriptor object.
take an extra argument for address args.
* net_db.c (scm_init_net_db): intern INADDR_ANY, INADDR_BROADCAST,
INADDR_NONE, INADDR_LOOPBACK.
* init.c: include net_db.h and not fdsocket.h.
(scm_boot_guile_1): call scm_init_net_db and not scm_init_fdsocket.
* Makefile.am: corresponding changes.
* socket.h: renamed from fdsocket.h, fix names.
* net_db.h: renamed from socket.h, fix names.
* socket.c: renamed from fdsocket.c.
remove _sys from procedure names.
(scm_init_socket): rename from scm_init_fdsocket. include socket.x.
add "socket" to features list.
* net_db.c: renamed from socket.c.
remove _sys from procedure names.
(scm_init_net_db): rename from scm_init_socket. include net_db.x.
add "net-db" to features list.
include "net_db.h". don't include <sys/socket.h> or
<sys/un.h>.
Diffstat (limited to 'libguile/socket.c')
-rw-r--r-- | libguile/socket.c | 930 |
1 files changed, 690 insertions, 240 deletions
diff --git a/libguile/socket.c b/libguile/socket.c index d28cd104e..fe8a67aaa 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -1,5 +1,4 @@ -/* "socket.c" internet socket support for client/server in SCM - * Copyright (C) 1995,1996 Free Software Foundation, Inc. +/* Copyright (C) 1996 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -39,23 +38,24 @@ * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ - -/* Written in 1994 by Aubrey Jaffer. - * Thanks to Hallvard.Tretteberg@si.sintef.no for inspiration and discussion. - * Rewritten by Gary Houston to be a closer interface to the C socket library. - */ #include <stdio.h> + #include "_scm.h" +#include "filesys.h" +#include "unif.h" #include "feature.h" +#include "fports.h" #include "socket.h" #ifdef HAVE_STRING_H #include <string.h> #endif - +#ifdef HAVE_UNISTD_H +#include <unistd.h> +#endif #include <sys/types.h> #include <sys/socket.h> #include <sys/un.h> @@ -65,334 +65,784 @@ -#ifndef STDC_HEADERS -int close (); -#endif /* STDC_HEADERS */ - -extern int inet_aton (); +static SCM scm_sock_fd_to_port SCM_P ((int fd, char *proc)); -SCM_PROC (s_sys_inet_aton, "inet-aton", 1, 0, 0, scm_sys_inet_aton); - -SCM -scm_sys_inet_aton (address) - SCM address; +static SCM +scm_sock_fd_to_port (fd, proc) + int fd; + char *proc; { - struct in_addr soka; - - SCM_ASSERT (SCM_NIMP (address) && SCM_ROSTRINGP (address), address, SCM_ARG1, s_sys_inet_aton); - if (SCM_SUBSTRP (address)) - address = scm_makfromstr (SCM_ROCHARS (address), SCM_ROLENGTH (address), 0); - if (inet_aton (SCM_ROCHARS (address), &soka) == 0) - scm_syserror (s_sys_inet_aton); - return scm_ulong2num (ntohl (soka.s_addr)); -} + SCM result; + FILE *f; + if (fd == -1) + scm_syserror (proc); + f = fdopen (fd, "r+"); + if (!f) + { + SCM_SYSCALL (close (fd)); + scm_syserror (proc); + } + SCM_NEWCELL (result); + { + struct scm_port_table *pt = scm_add_to_port_table (result); + + SCM_SETPTAB_ENTRY (result, pt); + } + SCM_SETCAR (result, scm_tc16_fport | scm_mode_bits ("r+0")); + SCM_SETSTREAM (result, (SCM)f); + scm_setbuf0 (result); + return result; +} -SCM_PROC (s_inet_ntoa, "inet-ntoa", 1, 0, 0, scm_inet_ntoa); +SCM_PROC (s_socket, "socket", 3, 0, 0, scm_socket); SCM -scm_inet_ntoa (inetid) - SCM inetid; +scm_socket (family, style, proto) + SCM family; + SCM style; + SCM proto; { - struct in_addr addr; - char *s; - SCM answer; - addr.s_addr = htonl (scm_num2ulong (inetid, (char *) SCM_ARG1, s_inet_ntoa)); + int fd; + SCM result; + + SCM_ASSERT (SCM_INUMP (family), family, SCM_ARG1, s_socket); + SCM_ASSERT (SCM_INUMP (style), style, SCM_ARG2, s_socket); + SCM_ASSERT (SCM_INUMP (proto), proto, SCM_ARG3, s_socket); SCM_DEFER_INTS; - s = inet_ntoa (addr); - answer = scm_makfromstr (s, strlen (s), 0); + fd = socket (SCM_INUM (family), SCM_INUM (style), SCM_INUM (proto)); + result = scm_sock_fd_to_port (fd, s_socket); SCM_ALLOW_INTS; - return answer; + return result; } -SCM_PROC (s_inet_netof, "inet-netof", 1, 0, 0, scm_inet_netof); -SCM -scm_inet_netof (address) - SCM address; -{ - struct in_addr addr; - addr.s_addr = htonl (scm_num2ulong (address, (char *) SCM_ARG1, s_inet_netof)); - return scm_ulong2num ((unsigned long) inet_netof (addr)); -} -SCM_PROC (s_lnaof, "lnaof", 1, 0, 0, scm_lnaof); +SCM_PROC (s_socketpair, "socketpair", 3, 0, 0, scm_socketpair); SCM -scm_lnaof (address) - SCM address; +scm_socketpair (family, style, proto) + SCM family; + SCM style; + SCM proto; { - struct in_addr addr; - addr.s_addr = htonl (scm_num2ulong (address, (char *) SCM_ARG1, s_lnaof)); - return scm_ulong2num ((unsigned long) inet_lnaof (addr)); + int fam; + int fd[2]; + SCM a; + SCM b; + + SCM_ASSERT (SCM_INUMP (family), family, SCM_ARG1, s_socketpair); + SCM_ASSERT (SCM_INUMP (style), style, SCM_ARG2, s_socketpair); + SCM_ASSERT (SCM_INUMP (proto), proto, SCM_ARG3, s_socketpair); + + fam = SCM_INUM (family); + + SCM_DEFER_INTS; + if (socketpair (fam, SCM_INUM (style), SCM_INUM (proto), fd) == -1) + scm_syserror (s_socketpair); + + a = scm_sock_fd_to_port (fd[0], s_socketpair); + b = scm_sock_fd_to_port (fd[1], s_socketpair); + SCM_ALLOW_INTS; + return scm_cons (a, b); } -SCM_PROC (s_inet_makeaddr, "inet-makeaddr", 2, 0, 0, scm_inet_makeaddr); +SCM_PROC (s_getsockopt, "getsockopt", 3, 0, 0, scm_getsockopt); -SCM -scm_inet_makeaddr (net, lna) - SCM net; - SCM lna; +SCM +scm_getsockopt (sock, level, optname) + SCM sock; + SCM level; + SCM optname; { - struct in_addr addr; - unsigned long netnum; - unsigned long lnanum; - - netnum = scm_num2ulong (net, (char *) SCM_ARG1, s_inet_makeaddr); - lnanum = scm_num2ulong (lna, (char *) SCM_ARG2, s_inet_makeaddr); - addr = inet_makeaddr (netnum, lnanum); - return scm_ulong2num (ntohl (addr.s_addr)); -} + int fd; + int optlen; +#ifdef HAVE_STRUCT_LINGER + char optval[sizeof (struct linger)]; +#else + char optval[sizeof (scm_sizet)]; +#endif + int ilevel; + int ioptname; +#ifdef HAVE_STRUCT_LINGER + optlen = (int) sizeof (struct linger); +#else + optlen = (int) sizeof (scm_sizet); +#endif -/* !!! Doesn't take address format. - * Assumes hostent stream isn't reused. - */ + SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, + s_getsockopt); + SCM_ASSERT (SCM_INUMP (level), level, SCM_ARG2, s_getsockopt); + SCM_ASSERT (SCM_INUMP (optname), optname, SCM_ARG3, s_getsockopt); -SCM_PROC (s_sys_gethost, "gethost", 0, 1, 0, scm_sys_gethost); + fd = fileno ((FILE *)SCM_STREAM (sock)); + ilevel = SCM_INUM (level); + ioptname = SCM_INUM (optname); + if (getsockopt (fd, ilevel, ioptname, (void *) optval, &optlen) == -1) + scm_syserror (s_getsockopt); -SCM -scm_sys_gethost (name) - SCM name; -{ - SCM ans = scm_make_vector (SCM_MAKINUM (5), SCM_UNSPECIFIED, SCM_BOOL_F); - SCM *ve = SCM_VELTS (ans); - SCM lst = SCM_EOL; - struct hostent *entry; - struct in_addr inad; - char **argv; - int i = 0; -#ifdef HAVE_GETHOSTENT - if (SCM_UNBNDP (name)) +#ifdef SO_LINGER + if (ilevel == SOL_SOCKET && ioptname == SO_LINGER) { - SCM_DEFER_INTS; - entry = gethostent (); - } - else +#ifdef HAVE_STRUCT_LINGER + struct linger *ling = (struct linger *) optval; + return scm_cons (SCM_MAKINUM (ling->l_onoff), + SCM_MAKINUM (ling->l_linger)); +#else + scm_sizet *ling = (scm_sizet *) optval; + return scm_cons (SCM_MAKINUM (*ling), + SCM_MAKINUM (0)); #endif - if (SCM_NIMP (name) && SCM_STRINGP (name)) - { - SCM_DEFER_INTS; - entry = gethostbyname (SCM_CHARS (name)); - } - else - { - inad.s_addr = htonl (scm_num2ulong (name, (char *) SCM_ARG1, s_sys_gethost)); - SCM_DEFER_INTS; - entry = gethostbyaddr ((char *) &inad, sizeof (inad), AF_INET); } - SCM_ALLOW_INTS; - if (!entry) - scm_syserror (s_sys_gethost); - ve[0] = scm_makfromstr (entry->h_name, (scm_sizet) strlen (entry->h_name), 0); - ve[1] = scm_makfromstrs (-1, entry->h_aliases); - ve[2] = SCM_MAKINUM (entry->h_addrtype + 0L); - ve[3] = SCM_MAKINUM (entry->h_length + 0L); - if (sizeof (struct in_addr) != entry->h_length) +#endif +#ifdef SO_SNDBUF + if (ilevel == SOL_SOCKET && ioptname == SO_SNDBUF) { - ve[4] = SCM_BOOL_F; - return ans; + scm_sizet *bufsize = (scm_sizet *) optval; + return SCM_MAKINUM (*bufsize); } - for (argv = entry->h_addr_list; argv[i]; i++); - while (i--) +#endif +#ifdef SO_RCVBUF + if (ilevel == SOL_SOCKET && ioptname == SO_RCVBUF) { - inad = *(struct in_addr *) argv[i]; - lst = scm_cons (scm_ulong2num (ntohl (inad.s_addr)), lst); + scm_sizet *bufsize = (scm_sizet *) optval; + return SCM_MAKINUM (*bufsize); } - ve[4] = lst; - return ans; +#endif + return SCM_MAKINUM (*(int *) optval); } +SCM_PROC (s_setsockopt, "setsockopt", 4, 0, 0, scm_setsockopt); -SCM_PROC (s_sys_getnet, "getnet", 0, 1, 0, scm_sys_getnet); - -SCM -scm_sys_getnet (name) - SCM name; +SCM +scm_setsockopt (sock, level, optname, value) + SCM sock; + SCM level; + SCM optname; + SCM value; { - SCM ans; - SCM *ve; - struct netent *entry; - - ans = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED, SCM_BOOL_F); - ve = SCM_VELTS (ans); - if (SCM_UNBNDP (name)) + int fd; + int optlen; +#ifdef HAVE_STRUCT_LINGER + char optval[sizeof (struct linger)]; /* Biggest option :-( */ +#else + char optval[sizeof (scm_sizet)]; +#endif + int ilevel, ioptname; + SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, + s_setsockopt); + SCM_ASSERT (SCM_INUMP (level), level, SCM_ARG2, s_setsockopt); + SCM_ASSERT (SCM_INUMP (optname), optname, SCM_ARG3, s_setsockopt); + fd = fileno ((FILE *)SCM_STREAM (sock)); + ilevel = SCM_INUM (level); + ioptname = SCM_INUM (optname); + if (0); +#ifdef SO_LINGER + else if (ilevel == SOL_SOCKET && ioptname == SO_LINGER) + { +#ifdef HAVE_STRUCT_LINGER + struct linger ling; + SCM_ASSERT (SCM_NIMP (value) && SCM_CONSP (value) + && SCM_INUMP (SCM_CAR (value)) + && SCM_INUMP (SCM_CDR (value)), + value, SCM_ARG4, s_setsockopt); + ling.l_onoff = SCM_INUM (SCM_CAR (value)); + ling.l_linger = SCM_INUM (SCM_CDR (value)); + optlen = (int) sizeof (struct linger); + memcpy (optval, (void *) &ling, optlen); +#else + scm_sizet ling; + SCM_ASSERT (SCM_NIMP (value) && SCM_CONSP (value) + && SCM_INUMP (SCM_CAR (value)) + && SCM_INUMP (SCM_CDR (value)), + value, SCM_ARG4, s_setsockopt); + ling = SCM_INUM (SCM_CAR (value)); + optlen = (int) sizeof (scm_sizet); + (*(scm_sizet *) optval) = (scm_sizet) SCM_INUM (value); +#endif + } +#endif +#ifdef SO_SNDBUF + else if (ilevel == SOL_SOCKET && ioptname == SO_SNDBUF) { - SCM_DEFER_INTS; - entry = getnetent (); + SCM_ASSERT (SCM_INUMP (value), value, SCM_ARG4, s_setsockopt); + optlen = (int) sizeof (scm_sizet); + (*(scm_sizet *) optval) = (scm_sizet) SCM_INUM (value); } - else if (SCM_NIMP (name) && SCM_STRINGP (name)) +#endif +#ifdef SO_RCVBUF + else if (ilevel == SOL_SOCKET && ioptname == SO_RCVBUF) { - SCM_DEFER_INTS; - entry = getnetbyname (SCM_CHARS (name)); + SCM_ASSERT (SCM_INUMP (value), value, SCM_ARG4, s_setsockopt); + optlen = (int) sizeof (scm_sizet); + (*(scm_sizet *) optval) = (scm_sizet) SCM_INUM (value); } +#endif else { - unsigned long netnum; - netnum = scm_num2ulong (name, (char *) SCM_ARG1, s_sys_getnet); - SCM_DEFER_INTS; - entry = getnetbyaddr (netnum, AF_INET); + /* Most options just take an int. */ + SCM_ASSERT (SCM_INUMP (value), value, SCM_ARG4, s_setsockopt); + optlen = (int) sizeof (int); + (*(int *) optval) = (int) SCM_INUM (value); } - SCM_ALLOW_INTS; - if (!entry) - scm_syserror (s_sys_getnet); - ve[0] = scm_makfromstr (entry->n_name, (scm_sizet) strlen (entry->n_name), 0); - ve[1] = scm_makfromstrs (-1, entry->n_aliases); - ve[2] = SCM_MAKINUM (entry->n_addrtype + 0L); - ve[3] = scm_ulong2num (entry->n_net + 0L); - return ans; + if (setsockopt (fd, ilevel, ioptname, (void *) optval, optlen) == -1) + scm_syserror (s_setsockopt); + return SCM_UNSPECIFIED; } -SCM_PROC (s_sys_getproto, "getproto", 0, 1, 0, scm_sys_getproto); +SCM_PROC (s_shutdown, "shutdown", 2, 0, 0, scm_shutdown); SCM -scm_sys_getproto (name) - SCM name; +scm_shutdown (sock, how) + SCM sock; + SCM how; { - SCM ans; - SCM *ve; - struct protoent *entry; + int fd; + SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, + s_shutdown); + SCM_ASSERT (SCM_INUMP (how) && 0 <= SCM_INUM (how) && 2 >= SCM_INUM (how), + how, SCM_ARG2, s_shutdown); + fd = fileno ((FILE *)SCM_STREAM (sock)); + if (shutdown (fd, SCM_INUM (how)) == -1) + scm_syserror (s_shutdown); + return SCM_UNSPECIFIED; +} - ans = scm_make_vector (SCM_MAKINUM (3), SCM_UNSPECIFIED, SCM_BOOL_F); - ve = SCM_VELTS (ans); - if (SCM_UNBNDP (name)) - { - SCM_DEFER_INTS; - entry = getprotoent (); - } - else if (SCM_NIMP (name) && SCM_STRINGP (name)) - { - SCM_DEFER_INTS; - entry = getprotobyname (SCM_CHARS (name)); - } - else +/* convert fam/address/args into a sockaddr of the appropriate type. + args is modified by removing the arguments actually used. + which_arg and proc are used when reporting errors: + which_arg is the position of address in the original argument list. + proc is the name of the original procedure. + size returns the size of the structure allocated. */ + + +static struct sockaddr * scm_fill_sockaddr SCM_P ((int fam, SCM address, SCM *args, int which_arg, char *proc, scm_sizet *size)); + +static struct sockaddr * +scm_fill_sockaddr (fam, address, args, which_arg, proc, size) + int fam; + SCM address; + SCM *args; + int which_arg; + char *proc; + scm_sizet *size; +{ + switch (fam) { - unsigned long protonum; - protonum = scm_num2ulong (name, (char *) SCM_ARG1, s_sys_getproto); - SCM_DEFER_INTS; - entry = getprotobynumber (protonum); + case AF_INET: + { + SCM isport; + struct sockaddr_in *soka; + + soka = (struct sockaddr_in *) + scm_must_malloc (sizeof (struct sockaddr_in), proc); + soka->sin_family = AF_INET; + soka->sin_addr.s_addr = + htonl (scm_num2ulong (address, (char *) which_arg, proc)); + SCM_ASSERT (SCM_NIMP (*args) && SCM_CONSP (*args), *args, + which_arg + 1, proc); + isport = SCM_CAR (*args); + *args = SCM_CDR (*args); + SCM_ASSERT (SCM_INUMP (isport), isport, which_arg + 1, proc); + soka->sin_port = htons (SCM_INUM (isport)); + *size = sizeof (struct sockaddr_in); + return (struct sockaddr *) soka; + } + case AF_UNIX: + { + struct sockaddr_un *soka; + + soka = (struct sockaddr_un *) + scm_must_malloc (sizeof (struct sockaddr_un), proc); + soka->sun_family = AF_UNIX; + SCM_ASSERT (SCM_NIMP (address) && SCM_STRINGP (address), address, + which_arg, proc); + memcpy (soka->sun_path, SCM_CHARS (address), 1 + SCM_LENGTH (address)); + *size = sizeof (struct sockaddr_un); + return (struct sockaddr *) soka; + } + default: + scm_out_of_range (proc, SCM_MAKINUM (fam)); } - SCM_ALLOW_INTS; - if (!entry) - scm_syserror (s_sys_getproto); - ve[0] = scm_makfromstr (entry->p_name, (scm_sizet) strlen (entry->p_name), 0); - ve[1] = scm_makfromstrs (-1, entry->p_aliases); - ve[2] = SCM_MAKINUM (entry->p_proto + 0L); - return ans; } + +SCM_PROC (s_connect, "connect", 3, 0, 1, scm_connect); +SCM +scm_connect (sock, fam, address, args) -static SCM scm_return_entry SCM_P ((struct servent *entry)); - -static SCM -scm_return_entry (entry) - struct servent *entry; + SCM sock; + SCM fam; + SCM address; + SCM args; { - SCM ans; - SCM *ve; + int fd; + struct sockaddr *soka; + scm_sizet size; - ans = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED, SCM_BOOL_F); - ve = SCM_VELTS (ans); - ve[0] = scm_makfromstr (entry->s_name, (scm_sizet) strlen (entry->s_name), 0); - ve[1] = scm_makfromstrs (-1, entry->s_aliases); - ve[2] = SCM_MAKINUM (ntohs (entry->s_port) + 0L); - ve[3] = scm_makfromstr (entry->s_proto, (scm_sizet) strlen (entry->s_proto), 0); + SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_connect); + SCM_ASSERT (SCM_INUMP (fam), fam, SCM_ARG2, s_connect); + fd = fileno ((FILE *)SCM_STREAM (sock)); + SCM_DEFER_INTS; + soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args, 3, s_connect, &size); + if (connect (fd, soka, size) == -1) + scm_syserror (s_connect); + scm_must_free ((char *) soka); SCM_ALLOW_INTS; - return ans; + return SCM_UNSPECIFIED; } -SCM_PROC (s_sys_getserv, "getserv", 0, 2, 0, scm_sys_getserv); +SCM_PROC (s_bind, "bind", 3, 0, 1, scm_bind); SCM -scm_sys_getserv (name, proto) - SCM name; - SCM proto; +scm_bind (sock, fam, address, args) + SCM sock; + SCM fam; + SCM address; + SCM args; +{ + int rv; + struct sockaddr *soka; + scm_sizet size; + int fd; + + SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_bind); + SCM_ASSERT (SCM_INUMP (fam), fam, SCM_ARG2, s_bind); + soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args, 3, s_bind, &size); + fd = fileno ((FILE *)SCM_STREAM (sock)); + rv = bind (fd, soka, size); + if (rv == -1) + scm_syserror (s_bind); + return SCM_UNSPECIFIED; +} + +SCM_PROC (s_listen, "listen", 2, 0, 0, scm_listen); + +SCM +scm_listen (sock, backlog) + SCM sock; + SCM backlog; +{ + int fd; + SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_listen); + SCM_ASSERT (SCM_INUMP (backlog), backlog, SCM_ARG2, s_listen); + fd = fileno ((FILE *)SCM_STREAM (sock)); + if (listen (fd, SCM_INUM (backlog)) == -1) + scm_syserror (s_listen); + return SCM_UNSPECIFIED; +} + +/* Put the components of a sockaddr into a new SCM vector. */ + +static SCM scm_addr_vector SCM_P ((struct sockaddr *address, char *proc)); + +static SCM +scm_addr_vector (address, proc) + struct sockaddr *address; + char *proc; { - struct servent *entry; - if (SCM_UNBNDP (name)) + short int fam = address->sa_family; + SCM result; + SCM *ve; + if (fam == AF_UNIX) { - SCM_DEFER_INTS; - entry = getservent (); - if (!entry) - scm_syserror (s_sys_getserv); - return scm_return_entry (entry); + struct sockaddr_un *nad = (struct sockaddr_un *) address; + result = scm_make_vector (SCM_MAKINUM (2), SCM_UNSPECIFIED, SCM_BOOL_F); + ve = SCM_VELTS (result); + ve[0] = scm_ulong2num ((unsigned long) fam); + ve[1] = scm_makfromstr (nad->sun_path, + (scm_sizet) strlen (nad->sun_path), 0); } - SCM_ASSERT (SCM_NIMP (proto) && SCM_STRINGP (proto), proto, SCM_ARG2, s_sys_getserv); - if (SCM_NIMP (name) && SCM_STRINGP (name)) + else if (fam == AF_INET) { - SCM_DEFER_INTS; - entry = getservbyname (SCM_CHARS (name), SCM_CHARS (proto)); + struct sockaddr_in *nad = (struct sockaddr_in *) address; + result = scm_make_vector (SCM_MAKINUM (3), SCM_UNSPECIFIED, SCM_BOOL_F); + ve = SCM_VELTS (result); + ve[0] = scm_ulong2num ((unsigned long) fam); + ve[1] = scm_ulong2num (ntohl (nad->sin_addr.s_addr)); + ve[2] = scm_ulong2num ((unsigned long) ntohs (nad->sin_port)); } else - { - SCM_ASSERT (SCM_INUMP (name), name, SCM_ARG1, s_sys_getserv); - SCM_DEFER_INTS; - entry = getservbyport (SCM_INUM (name), SCM_CHARS (proto)); - } - if (!entry) - scm_syserror (s_sys_getserv); - return scm_return_entry (entry); + scm_misc_error (proc, "Unrecognised socket address type: %s", + scm_listify (SCM_MAKINUM (fam))); + + return result; +} + +/* Allocate a buffer large enough to hold any sockaddr type. */ +static char *scm_addr_buffer; +static int scm_addr_buffer_size; + +static void scm_init_addr_buffer SCM_P ((void)); + +static void +scm_init_addr_buffer () +{ + scm_addr_buffer_size = (int) sizeof (struct sockaddr_un); + if (sizeof (struct sockaddr_in) > scm_addr_buffer_size) + scm_addr_buffer_size = (int) sizeof (struct sockaddr_in); + scm_addr_buffer = scm_must_malloc (scm_addr_buffer_size, "address buffer"); } -SCM_PROC (s_sethost, "sethost", 0, 1, 0, scm_sethost); +SCM_PROC (s_accept, "accept", 1, 0, 0, scm_accept); SCM -scm_sethost (arg) - SCM arg; +scm_accept (sock) + SCM sock; { - if (SCM_UNBNDP (arg)) - endhostent (); + int fd; + int newfd; + SCM address; + SCM newsock; + + int tmp_size; + SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_accept); + fd = fileno ((FILE *)SCM_STREAM (sock)); + SCM_DEFER_INTS; + tmp_size = scm_addr_buffer_size; + newfd = accept (fd, (struct sockaddr *) scm_addr_buffer, &tmp_size); + newsock = scm_sock_fd_to_port (newfd, s_accept); + if (tmp_size > 0) + address = scm_addr_vector ((struct sockaddr *) scm_addr_buffer, s_accept); else - sethostent (SCM_NFALSEP (arg)); - return SCM_UNSPECIFIED; + address = SCM_BOOL_F; + + SCM_ALLOW_INTS; + return scm_cons (newsock, address); } -SCM_PROC (s_setnet, "setnet", 0, 1, 0, scm_setnet); +SCM_PROC (s_getsockname, "getsockname", 1, 0, 0, scm_getsockname); SCM -scm_setnet (arg) - SCM arg; +scm_getsockname (sock) + SCM sock; { - if (SCM_UNBNDP (arg)) - endnetent (); + int tmp_size; + int fd; + SCM result; + SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_getsockname); + fd = fileno ((FILE *)SCM_STREAM (sock)); + SCM_DEFER_INTS; + tmp_size = scm_addr_buffer_size; + if (getsockname (fd, (struct sockaddr *) scm_addr_buffer, &tmp_size) == -1) + scm_syserror (s_getsockname); + if (tmp_size > 0) + result = scm_addr_vector ((struct sockaddr *) scm_addr_buffer, s_getsockname); else - setnetent (SCM_NFALSEP (arg)); - return SCM_UNSPECIFIED; + result = SCM_BOOL_F; + SCM_ALLOW_INTS; + return result; } -SCM_PROC (s_setproto, "setproto", 0, 1, 0, scm_setproto); +SCM_PROC (s_getpeername, "getpeername", 1, 0, 0, scm_getpeername); SCM -scm_setproto (arg) - SCM arg; +scm_getpeername (sock) + SCM sock; { - if (SCM_UNBNDP (arg)) - endprotoent (); + int tmp_size; + int fd; + SCM result; + SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_getpeername); + fd = fileno ((FILE *)SCM_STREAM (sock)); + SCM_DEFER_INTS; + tmp_size = scm_addr_buffer_size; + if (getpeername (fd, (struct sockaddr *) scm_addr_buffer, &tmp_size) == -1) + scm_syserror (s_getpeername); + if (tmp_size > 0) + result = scm_addr_vector ((struct sockaddr *) scm_addr_buffer, s_getpeername); else - setprotoent (SCM_NFALSEP (arg)); - return SCM_UNSPECIFIED; + result = SCM_BOOL_F; + SCM_ALLOW_INTS; + return result; } -SCM_PROC (s_setserv, "setserv", 0, 1, 0, scm_setserv); +SCM_PROC (s_recv, "recv", 2, 1, 0, scm_recv); -SCM -scm_setserv (arg) - SCM arg; +SCM +scm_recv (sock, buff_or_size, flags) + SCM sock; + SCM buff_or_size; + SCM flags; { - if (SCM_UNBNDP (arg)) - endservent (); + int rv; + int fd; + int flg; + SCM tok_buf; + char *p; + int size; + int allocated = 0; + + SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_recv); + if (SCM_INUMP (buff_or_size)) + { + size = SCM_INUM (buff_or_size); + tok_buf = scm_makstr (size, 0); + allocated = 1; + } else - setservent (SCM_NFALSEP (arg)); - return SCM_UNSPECIFIED; + { + SCM_ASSERT (SCM_NIMP (buff_or_size) && SCM_STRINGP (buff_or_size), + buff_or_size, SCM_ARG2, s_recv); + tok_buf = buff_or_size; + size = SCM_LENGTH (tok_buf); + } + p = SCM_CHARS (tok_buf); + fd = fileno ((FILE *)SCM_STREAM (sock)); + + if (SCM_UNBNDP (flags)) + flg = 0; + else + flg = scm_num2ulong (flags, (char *) SCM_ARG3, s_recv); + + SCM_SYSCALL (rv = recv (fd, p, size, flg)); + if (rv == -1) + scm_syserror (s_recv); + + return scm_cons (allocated + ? scm_vector_set_length_x (tok_buf, (SCM) SCM_MAKINUM (rv)) + : tok_buf, + SCM_MAKINUM (rv)); +} + +SCM_PROC (s_send, "send", 2, 1, 0, scm_send); + +SCM +scm_send (sock, message, flags) + SCM sock; + SCM message; + SCM flags; +{ + int rv; + int fd; + int flg; + + SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_send); + SCM_ASSERT (SCM_NIMP (message) && SCM_STRINGP (message), message, SCM_ARG2, s_send); + fd = fileno ((FILE *)SCM_STREAM (sock)); + + if (SCM_UNBNDP (flags)) + flg = 0; + else + flg = scm_num2ulong (flags, (char *) SCM_ARG3, s_send); + + SCM_SYSCALL (rv = send (fd, SCM_CHARS (message), SCM_LENGTH (message), flg)); + if (rv == -1) + scm_syserror (s_send); + return SCM_MAKINUM (rv); +} + +SCM_PROC (s_recvfrom, "recvfrom", 2, 1, 0, scm_recvfrom); + +SCM +scm_recvfrom (sock, buff_or_size, flags) + SCM sock; + SCM buff_or_size; + SCM flags; +{ + int rv; + int fd; + int flg; + SCM tok_buf; + char *p; + int size; + int allocated = 0; + int tmp_size; + SCM address; + + SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_recvfrom); + if (SCM_INUMP (buff_or_size)) + { + size = SCM_INUM (buff_or_size); + tok_buf = scm_makstr (size, 0); + allocated = 1; + } + else + { + SCM_ASSERT (SCM_NIMP (buff_or_size) && SCM_STRINGP (buff_or_size), + buff_or_size, SCM_ARG2, s_recvfrom); + tok_buf = buff_or_size; + size = SCM_LENGTH (tok_buf); + } + p = SCM_CHARS (tok_buf); + fd = fileno ((FILE *)SCM_STREAM (sock)); + + if (SCM_UNBNDP (flags)) + flg = 0; + else + flg = scm_num2ulong (flags, (char *) SCM_ARG3, s_recvfrom); + + tmp_size = scm_addr_buffer_size; + SCM_SYSCALL (rv = recvfrom (fd, p, size, flg, + (struct sockaddr *) scm_addr_buffer, + &tmp_size)); + if (rv == -1) + scm_syserror (s_recvfrom); + if (tmp_size > 0) + address = scm_addr_vector ((struct sockaddr *) scm_addr_buffer, s_recvfrom); + else + address = SCM_BOOL_F; + + return scm_listify (allocated + ? scm_vector_set_length_x (tok_buf, + (SCM) SCM_MAKINUM (rv)) + : tok_buf, + SCM_MAKINUM (rv), + address, + SCM_UNDEFINED); } +SCM_PROC (s_sendto, "sendto", 4, 0, 1, scm_sendto); -void +SCM +scm_sendto (sock, message, fam, address, args_and_flags) + SCM sock; + SCM message; + SCM fam; + SCM address; + SCM args_and_flags; +{ + int rv; + int fd; + int flg; + struct sockaddr *soka; + scm_sizet size; + + SCM_ASSERT (SCM_NIMP (sock) && SCM_FPORTP (sock), sock, SCM_ARG1, s_sendto); + SCM_ASSERT (SCM_NIMP (message) && SCM_STRINGP (message), message, SCM_ARG2, s_sendto); + SCM_ASSERT (SCM_INUMP (fam), fam, SCM_ARG3, s_sendto); + fd = fileno ((FILE *)SCM_STREAM (sock)); + SCM_DEFER_INTS; + soka = scm_fill_sockaddr (SCM_INUM (fam), address, &args_and_flags, 4, + s_sendto, &size); + if (SCM_NULLP (args_and_flags)) + flg = 0; + else + { + SCM_ASSERT (SCM_NIMP (args_and_flags) && SCM_CONSP (args_and_flags), + args_and_flags, SCM_ARG5, s_sendto); + flg = scm_num2ulong (SCM_CAR (args_and_flags), (char *) SCM_ARG5, s_sendto); + } + SCM_SYSCALL (rv = sendto (fd, SCM_CHARS (message), SCM_LENGTH (message), flg, + soka, size)); + if (rv == -1) + scm_syserror (s_sendto); + scm_must_free ((char *) soka); + SCM_ALLOW_INTS; + return SCM_MAKINUM (rv); +} + + + +void scm_init_socket () { + /* protocol families. */ +#ifdef AF_UNSPEC + scm_sysintern ("AF_UNSPEC", SCM_MAKINUM (AF_UNSPEC)); +#endif +#ifdef AF_UNIX + scm_sysintern ("AF_UNIX", SCM_MAKINUM (AF_UNIX)); +#endif +#ifdef AF_INET + scm_sysintern ("AF_INET", SCM_MAKINUM (AF_INET)); +#endif + +#ifdef PF_UNSPEC + scm_sysintern ("PF_UNSPEC", SCM_MAKINUM (PF_UNSPEC)); +#endif +#ifdef PF_UNIX + scm_sysintern ("PF_UNIX", SCM_MAKINUM (PF_UNIX)); +#endif +#ifdef PF_INET + scm_sysintern ("PF_INET", SCM_MAKINUM (PF_INET)); +#endif + + /* socket types. */ +#ifdef SOCK_STREAM + scm_sysintern ("SOCK_STREAM", SCM_MAKINUM (SOCK_STREAM)); +#endif +#ifdef SOCK_DGRAM + scm_sysintern ("SOCK_DGRAM", SCM_MAKINUM (SOCK_DGRAM)); +#endif +#ifdef SOCK_RAW + scm_sysintern ("SOCK_RAW", SCM_MAKINUM (SOCK_RAW)); +#endif + + /* setsockopt level. */ +#ifdef SOL_SOCKET + scm_sysintern ("SOL_SOCKET", SCM_MAKINUM (SOL_SOCKET)); +#endif +#ifdef SOL_IP + scm_sysintern ("SOL_IP", SCM_MAKINUM (SOL_IP)); +#endif +#ifdef SOL_TCP + scm_sysintern ("SOL_TCP", SCM_MAKINUM (SOL_TCP)); +#endif +#ifdef SOL_UDP + scm_sysintern ("SOL_UDP", SCM_MAKINUM (SOL_UDP)); +#endif + + /* setsockopt names. */ +#ifdef SO_DEBUG + scm_sysintern ("SO_DEBUG", SCM_MAKINUM (SO_DEBUG)); +#endif +#ifdef SO_REUSEADDR + scm_sysintern ("SO_REUSEADDR", SCM_MAKINUM (SO_REUSEADDR)); +#endif +#ifdef SO_STYLE + scm_sysintern ("SO_STYLE", SCM_MAKINUM (SO_STYLE)); +#endif +#ifdef SO_TYPE + scm_sysintern ("SO_TYPE", SCM_MAKINUM (SO_TYPE)); +#endif +#ifdef SO_ERROR + scm_sysintern ("SO_ERROR", SCM_MAKINUM (SO_ERROR)); +#endif +#ifdef SO_DONTROUTE + scm_sysintern ("SO_DONTROUTE", SCM_MAKINUM (SO_DONTROUTE)); +#endif +#ifdef SO_BROADCAST + scm_sysintern ("SO_BROADCAST", SCM_MAKINUM (SO_BROADCAST)); +#endif +#ifdef SO_SNDBUF + scm_sysintern ("SO_SNDBUF", SCM_MAKINUM (SO_SNDBUF)); +#endif +#ifdef SO_RCVBUF + scm_sysintern ("SO_RCVBUF", SCM_MAKINUM (SO_RCVBUF)); +#endif +#ifdef SO_KEEPALIVE + scm_sysintern ("SO_KEEPALIVE", SCM_MAKINUM (SO_KEEPALIVE)); +#endif +#ifdef SO_OOBINLINE + scm_sysintern ("SO_OOBINLINE", SCM_MAKINUM (SO_OOBINLINE)); +#endif +#ifdef SO_NO_CHECK + scm_sysintern ("SO_NO_CHECK", SCM_MAKINUM (SO_NO_CHECK)); +#endif +#ifdef SO_PRIORITY + scm_sysintern ("SO_PRIORITY", SCM_MAKINUM (SO_PRIORITY)); +#endif +#ifdef SO_LINGER + scm_sysintern ("SO_LINGER", SCM_MAKINUM (SO_LINGER)); +#endif + + /* recv/send options. */ +#ifdef MSG_OOB + scm_sysintern ("MSG_OOB", SCM_MAKINUM (MSG_OOB)); +#endif +#ifdef MSG_PEEK + scm_sysintern ("MSG_PEEK", SCM_MAKINUM (MSG_PEEK)); +#endif +#ifdef MSG_DONTROUTE + scm_sysintern ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE)); +#endif + scm_add_feature ("socket"); + scm_init_addr_buffer (); + #include "socket.x" } - |