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 | |
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>.
-rw-r--r-- | libguile/ChangeLog | 55 | ||||
-rw-r--r-- | libguile/Makefile.am | 10 | ||||
-rw-r--r-- | libguile/Makefile.in | 76 | ||||
-rwxr-xr-x | libguile/configure | 1 | ||||
-rw-r--r-- | libguile/filesys.c | 18 | ||||
-rw-r--r-- | libguile/init.c | 4 | ||||
-rw-r--r-- | libguile/net_db.c | 410 | ||||
-rw-r--r-- | libguile/net_db.h | 69 | ||||
-rw-r--r-- | libguile/socket.c | 930 | ||||
-rw-r--r-- | libguile/socket.h | 29 |
10 files changed, 1296 insertions, 306 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index c1c4a0673..dea0428cd 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,58 @@ +Sat Dec 21 00:33:03 1996 Gary Houston <ghouston@actrix.gen.nz> + + * 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. + +Thu Dec 19 00:00:26 1996 Gary Houston <ghouston@actrix.gen.nz> + + * 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. + +Tue Dec 17 22:58:26 1996 Gary Houston <ghouston@actrix.gen.nz> + + * 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>. + Thu Dec 19 14:03:24 1996 Mikael Djurfeldt <mdj@mdj.nada.kth.se> * tags.h (scm_tags): Removed comma at end of last enumerator. diff --git a/libguile/Makefile.am b/libguile/Makefile.am index b944b49be..78c2812bb 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -10,9 +10,10 @@ INCLUDES = -I.. -I$(srcdir)/.. lib_LIBRARIES = libguile.a libguile_a_SOURCES = alist.c append.c appinit.c arbiters.c async.c \ backtrace.c boolean.c chars.c continuations.c debug.c dynl.c dynwind.c eq.c \ -error.c eval.c extchrs.c fdsocket.c feature.c filesys.c fports.c gc.c \ +error.c eval.c extchrs.c feature.c filesys.c fports.c gc.c \ gdbint.c genio.c gsubr.c hash.c hashtab.c inet_aton.c init.c ioext.c \ -kw.c list.c load.c mallocs.c markers.c mbstrings.c numbers.c objprop.c \ +kw.c list.c load.c mallocs.c markers.c mbstrings.c net_db.c \ +numbers.c objprop.c \ options.c pairs.c ports.c posix.c print.c procprop.c procs.c ramap.c \ read.c root.c scmsigs.c sequences.c simpos.c smob.c socket.c srcprop.c \ stackchk.c stacks.c stime.c strerror.c strings.c strop.c strorder.c \ @@ -25,9 +26,10 @@ include_HEADERS = libguile.h modincludedir = $(includedir)/@module@ modinclude_HEADERS = __scm.h alist.h append.h arbiters.h async.h \ backtrace.h boolean.h chars.h continuations.h debug.h dynl.h dynwind.h eq.h \ -error.h eval.h extchrs.h fdsocket.h feature.h filesys.h fports.h gc.h \ +error.h eval.h extchrs.h feature.h filesys.h fports.h gc.h \ gdb_interface.h gdbint.h genio.h gsubr.h hash.h hashtab.h init.h ioext.h \ -kw.h list.h load.h mallocs.h markers.h mbstrings.h numbers.h objprop.h \ +kw.h list.h load.h mallocs.h markers.h mbstrings.h net_db.h \ +numbers.h objprop.h \ options.h pairs.h ports.h posix.h print.h procprop.h procs.h ramap.h read.h \ root.h scmhob.h scmsigs.h sequences.h simpos.h smob.h socket.h srcprop.h \ stackchk.h stacks.h stime.h strings.h strop.h strorder.h strports.h struct.h \ diff --git a/libguile/Makefile.in b/libguile/Makefile.in index 6c779f9e3..77e6f14d3 100644 --- a/libguile/Makefile.in +++ b/libguile/Makefile.in @@ -37,13 +37,13 @@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_SCRIPT = @INSTALL_SCRIPT@ transform = @program_transform_name@ -VERSION = @VERSION@ +FD_SETTER = @FD_SETTER@ RANLIB = @RANLIB@ INSTALL_SCRIPT = @INSTALL_SCRIPT@ +PACKAGE = @PACKAGE@ +VERSION = @VERSION@ module = @module@ CC = @CC@ -PACKAGE = @PACKAGE@ -FD_SETTER = @FD_SETTER@ AUTOMAKE_OPTIONS = foreign @@ -52,9 +52,10 @@ INCLUDES = -I.. -I$(srcdir)/.. lib_LIBRARIES = libguile.a libguile_a_SOURCES = alist.c append.c appinit.c arbiters.c async.c \ backtrace.c boolean.c chars.c continuations.c debug.c dynl.c dynwind.c eq.c \ -error.c eval.c extchrs.c fdsocket.c feature.c filesys.c fports.c gc.c \ +error.c eval.c extchrs.c feature.c filesys.c fports.c gc.c \ gdbint.c genio.c gsubr.c hash.c hashtab.c inet_aton.c init.c ioext.c \ -kw.c list.c load.c mallocs.c markers.c mbstrings.c numbers.c objprop.c \ +kw.c list.c load.c mallocs.c markers.c mbstrings.c net_db.c \ +numbers.c objprop.c \ options.c pairs.c ports.c posix.c print.c procprop.c procs.c ramap.c \ read.c root.c scmsigs.c sequences.c simpos.c smob.c socket.c srcprop.c \ stackchk.c stacks.c stime.c strerror.c strings.c strop.c strorder.c \ @@ -67,9 +68,10 @@ include_HEADERS = libguile.h modincludedir = $(includedir)/@module@ modinclude_HEADERS = __scm.h alist.h append.h arbiters.h async.h \ backtrace.h boolean.h chars.h continuations.h debug.h dynl.h dynwind.h eq.h \ -error.h eval.h extchrs.h fdsocket.h feature.h filesys.h fports.h gc.h \ +error.h eval.h extchrs.h feature.h filesys.h fports.h gc.h \ gdb_interface.h gdbint.h genio.h gsubr.h hash.h hashtab.h init.h ioext.h \ -kw.h list.h load.h mallocs.h markers.h mbstrings.h numbers.h objprop.h \ +kw.h list.h load.h mallocs.h markers.h mbstrings.h net_db.h \ +numbers.h objprop.h \ options.h pairs.h ports.h posix.h print.h procprop.h procs.h ramap.h read.h \ root.h scmhob.h scmsigs.h sequences.h simpos.h smob.h socket.h srcprop.h \ stackchk.h stacks.h stime.h strings.h strop.h strorder.h strports.h struct.h \ @@ -101,9 +103,9 @@ LIBS = @LIBS@ libguile_a_LIBADD = libguile_a_OBJECTS = alist.o append.o appinit.o arbiters.o async.o \ backtrace.o boolean.o chars.o continuations.o debug.o dynl.o dynwind.o \ -eq.o error.o eval.o extchrs.o fdsocket.o feature.o filesys.o fports.o \ -gc.o gdbint.o genio.o gsubr.o hash.o hashtab.o inet_aton.o init.o \ -ioext.o kw.o list.o load.o mallocs.o markers.o mbstrings.o numbers.o \ +eq.o error.o eval.o extchrs.o feature.o filesys.o fports.o gc.o \ +gdbint.o genio.o gsubr.o hash.o hashtab.o inet_aton.o init.o ioext.o \ +kw.o list.o load.o mallocs.o markers.o mbstrings.o net_db.o numbers.o \ objprop.o options.o pairs.o ports.o posix.o print.o procprop.o procs.o \ ramap.o read.o root.o scmsigs.o sequences.o simpos.o smob.o socket.o \ srcprop.o stackchk.o stacks.o stime.o strerror.o strings.o strop.o \ @@ -117,7 +119,7 @@ COMPILE = $(CC) $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) LINK = $(CC) $(LDFLAGS) -o $@ DATA = $(modinclude_DATA) -HEADERS = $(modinclude_HEADERS) $(include_HEADERS) +HEADERS = $(include_HEADERS) $(modinclude_HEADERS) DIST_COMMON = COPYING ChangeLog Makefile.am Makefile.in acconfig.h \ acinclude.m4 aclocal.m4 configure configure.in fd.h.in guile-snarf.in \ @@ -132,11 +134,11 @@ DEP_FILES = .deps/alist.P .deps/append.P .deps/appinit.P \ .deps/arbiters.P .deps/async.P .deps/backtrace.P .deps/boolean.P \ .deps/chars.P .deps/continuations.P .deps/debug.P .deps/dynl.P \ .deps/dynwind.P .deps/eq.P .deps/error.P .deps/eval.P .deps/extchrs.P \ -.deps/fdsocket.P .deps/feature.P .deps/filesys.P .deps/fports.P \ -.deps/gc.P .deps/gdbint.P .deps/genio.P .deps/gsubr.P .deps/hash.P \ -.deps/hashtab.P .deps/inet_aton.P .deps/init.P .deps/ioext.P .deps/kw.P \ -.deps/list.P .deps/load.P .deps/mallocs.P .deps/markers.P \ -.deps/mbstrings.P .deps/numbers.P .deps/objprop.P .deps/options.P \ +.deps/feature.P .deps/filesys.P .deps/fports.P .deps/gc.P \ +.deps/gdbint.P .deps/genio.P .deps/gsubr.P .deps/hash.P .deps/hashtab.P \ +.deps/inet_aton.P .deps/init.P .deps/ioext.P .deps/kw.P .deps/list.P \ +.deps/load.P .deps/mallocs.P .deps/markers.P .deps/mbstrings.P \ +.deps/net_db.P .deps/numbers.P .deps/objprop.P .deps/options.P \ .deps/pairs.P .deps/ports.P .deps/posix.P .deps/print.P \ .deps/procprop.P .deps/procs.P .deps/ramap.P .deps/read.P .deps/root.P \ .deps/scmsigs.P .deps/sequences.P .deps/simpos.P .deps/smob.P \ @@ -277,19 +279,6 @@ uninstall-modincludeDATA: rm -f $(modincludedir)/$$p; \ done -install-modincludeHEADERS: $(modinclude_HEADERS) - $(NORMAL_INSTALL) - $(mkinstalldirs) $(modincludedir) - @list="$(modinclude_HEADERS)"; for p in $$list; do \ - echo "$(INSTALL_DATA) $(srcdir)/$$p $(modincludedir)/$$p"; \ - $(INSTALL_DATA) $(srcdir)/$$p $(modincludedir)/$$p; \ - done - -uninstall-modincludeHEADERS: - list="$(modinclude_HEADERS)"; for p in $$list; do \ - rm -f $(modincludedir)/$$p; \ - done - install-includeHEADERS: $(include_HEADERS) $(NORMAL_INSTALL) $(mkinstalldirs) $(includedir) @@ -303,6 +292,19 @@ uninstall-includeHEADERS: rm -f $(includedir)/$$p; \ done +install-modincludeHEADERS: $(modinclude_HEADERS) + $(NORMAL_INSTALL) + $(mkinstalldirs) $(modincludedir) + @list="$(modinclude_HEADERS)"; for p in $$list; do \ + echo "$(INSTALL_DATA) $(srcdir)/$$p $(modincludedir)/$$p"; \ + $(INSTALL_DATA) $(srcdir)/$$p $(modincludedir)/$$p; \ + done + +uninstall-modincludeHEADERS: + list="$(modinclude_HEADERS)"; for p in $$list; do \ + rm -f $(modincludedir)/$$p; \ + done + tags: TAGS ID: $(HEADERS) $(SOURCES) @@ -399,21 +401,21 @@ installcheck: install-exec: install-libLIBRARIES install-binSCRIPTS $(NORMAL_INSTALL) -install-data: install-modincludeDATA install-modincludeHEADERS install-includeHEADERS +install-data: install-modincludeDATA install-includeHEADERS install-modincludeHEADERS $(NORMAL_INSTALL) install: install-exec install-data all @: -uninstall: uninstall-libLIBRARIES uninstall-binSCRIPTS uninstall-modincludeDATA uninstall-modincludeHEADERS uninstall-includeHEADERS +uninstall: uninstall-libLIBRARIES uninstall-binSCRIPTS uninstall-modincludeDATA uninstall-includeHEADERS uninstall-modincludeHEADERS all: $(LIBRARIES) $(SCRIPTS) $(DATA) $(HEADERS) Makefile scmconfig.h install-strip: $(MAKE) INSTALL_PROGRAM='$(INSTALL_PROGRAM) -s' install installdirs: - $(mkinstalldirs) $(libdir) $(bindir) $(modincludedir) $(modincludedir) \ - $(includedir) + $(mkinstalldirs) $(libdir) $(bindir) $(modincludedir) $(includedir) \ + $(modincludedir) mostlyclean-generic: @@ -455,10 +457,10 @@ clean-libLIBRARIES maintainer-clean-libLIBRARIES uninstall-libLIBRARIES \ install-libLIBRARIES mostlyclean-compile distclean-compile \ clean-compile maintainer-clean-compile uninstall-binSCRIPTS \ install-binSCRIPTS uninstall-modincludeDATA install-modincludeDATA \ -uninstall-modincludeHEADERS install-modincludeHEADERS \ -uninstall-includeHEADERS install-includeHEADERS tags mostlyclean-tags \ -distclean-tags clean-tags maintainer-clean-tags distdir \ -mostlyclean-depend distclean-depend clean-depend \ +uninstall-includeHEADERS install-includeHEADERS \ +uninstall-modincludeHEADERS install-modincludeHEADERS tags \ +mostlyclean-tags distclean-tags clean-tags maintainer-clean-tags \ +distdir mostlyclean-depend distclean-depend clean-depend \ maintainer-clean-depend info dvi installcheck install-exec install-data \ install uninstall all installdirs mostlyclean-generic distclean-generic \ clean-generic maintainer-clean-generic clean mostlyclean distclean \ diff --git a/libguile/configure b/libguile/configure index e156c59b0..9e0abfea5 100755 --- a/libguile/configure +++ b/libguile/configure @@ -3043,7 +3043,6 @@ fi; done EOF cat >> $CONFIG_STATUS <<EOF - EOF cat >> $CONFIG_STATUS <<\EOF test -z "$CONFIG_HEADER" || echo timestamp > stamp-h diff --git a/libguile/filesys.c b/libguile/filesys.c index 38f0b7768..1f65c8875 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -1125,14 +1125,7 @@ scm_input_waiting_p (f, caller) # endif /* Is the file prepared to deliver input? */ -# ifdef FIONREAD - { - long remir; - ioctl(fileno(f), FIONREAD, &remir); - return remir; - } -# else -# ifdef HAVE_SELECT +# ifdef HAVE_SELECT { struct timeval timeout; SELECT_TYPE read_set; @@ -1157,8 +1150,15 @@ scm_input_waiting_p (f, caller) SCM_ALLOW_INTS; return FD_ISSET (fno, &read_set); } +# else +# ifdef FIONREAD + { + long remir; + ioctl(fileno(f), FIONREAD, &remir); + return remir; + } # else - return -1; + scm_misc_error ("char-ready?", "Not fully implemented\n"); # endif # endif } diff --git a/libguile/init.c b/libguile/init.c index edbffd208..2bcfb76fd 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -60,7 +60,6 @@ #include "eq.h" #include "error.h" #include "eval.h" -#include "fdsocket.h" #include "feature.h" #include "filesys.h" #include "fports.h" @@ -75,6 +74,7 @@ #include "load.h" #include "mallocs.h" #include "mbstrings.h" +#include "net_db.h" #include "numbers.h" #include "objprop.h" #include "options.h" @@ -362,7 +362,6 @@ scm_boot_guile_1 (base, argc, argv, main_func, closure) scm_init_dynwind (); scm_init_eq (); scm_init_error (); - scm_init_fdsocket (); scm_init_fports (); scm_init_filesys (); scm_init_gc (); @@ -373,6 +372,7 @@ scm_boot_guile_1 (base, argc, argv, main_func, closure) scm_init_kw (); scm_init_list (); scm_init_mallocs (); + scm_init_net_db (); scm_init_numbers (); scm_init_objprop (); #if DEBUG_EXTENSIONS diff --git a/libguile/net_db.c b/libguile/net_db.c new file mode 100644 index 000000000..100953c13 --- /dev/null +++ b/libguile/net_db.c @@ -0,0 +1,410 @@ +/* "net_db.c" network database support + * Copyright (C) 1995,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 + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * 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. + * Split into net_db.c and socket.c. + */ + + +#include <stdio.h> +#include "_scm.h" +#include "feature.h" + +#include "net_db.h" + +#ifdef HAVE_STRING_H +#include <string.h> +#endif + +#include <sys/types.h> +#include <netdb.h> +#include <netinet/in.h> +#include <arpa/inet.h> + + + +#ifndef STDC_HEADERS +int close (); +#endif /* STDC_HEADERS */ + +extern int inet_aton (); + +SCM_PROC (s_inet_aton, "inet-aton", 1, 0, 0, scm_inet_aton); + +SCM +scm_inet_aton (address) + SCM address; +{ + struct in_addr soka; + + SCM_ASSERT (SCM_NIMP (address) && SCM_ROSTRINGP (address), address, SCM_ARG1, s_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_inet_aton); + return scm_ulong2num (ntohl (soka.s_addr)); +} + + +SCM_PROC (s_inet_ntoa, "inet-ntoa", 1, 0, 0, scm_inet_ntoa); + +SCM +scm_inet_ntoa (inetid) + SCM inetid; +{ + struct in_addr addr; + char *s; + SCM answer; + addr.s_addr = htonl (scm_num2ulong (inetid, (char *) SCM_ARG1, s_inet_ntoa)); + SCM_DEFER_INTS; + s = inet_ntoa (addr); + answer = scm_makfromstr (s, strlen (s), 0); + SCM_ALLOW_INTS; + return answer; +} + +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 +scm_lnaof (address) + SCM address; +{ + struct in_addr addr; + addr.s_addr = htonl (scm_num2ulong (address, (char *) SCM_ARG1, s_lnaof)); + return scm_ulong2num ((unsigned long) inet_lnaof (addr)); +} + + +SCM_PROC (s_inet_makeaddr, "inet-makeaddr", 2, 0, 0, scm_inet_makeaddr); + +SCM +scm_inet_makeaddr (net, lna) + SCM net; + SCM lna; +{ + 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)); +} + + +/* !!! Doesn't take address format. + * Assumes hostent stream isn't reused. + */ + +SCM_PROC (s_gethost, "gethost", 0, 1, 0, scm_gethost); + +SCM +scm_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)) + { + SCM_DEFER_INTS; + entry = gethostent (); + } + else +#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_gethost)); + SCM_DEFER_INTS; + entry = gethostbyaddr ((char *) &inad, sizeof (inad), AF_INET); + } + SCM_ALLOW_INTS; + if (!entry) + scm_syserror (s_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) + { + ve[4] = SCM_BOOL_F; + return ans; + } + for (argv = entry->h_addr_list; argv[i]; i++); + while (i--) + { + inad = *(struct in_addr *) argv[i]; + lst = scm_cons (scm_ulong2num (ntohl (inad.s_addr)), lst); + } + ve[4] = lst; + return ans; +} + + +SCM_PROC (s_getnet, "getnet", 0, 1, 0, scm_getnet); + +SCM +scm_getnet (name) + SCM name; +{ + 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)) + { + SCM_DEFER_INTS; + entry = getnetent (); + } + else if (SCM_NIMP (name) && SCM_STRINGP (name)) + { + SCM_DEFER_INTS; + entry = getnetbyname (SCM_CHARS (name)); + } + else + { + unsigned long netnum; + netnum = scm_num2ulong (name, (char *) SCM_ARG1, s_getnet); + SCM_DEFER_INTS; + entry = getnetbyaddr (netnum, AF_INET); + } + SCM_ALLOW_INTS; + if (!entry) + scm_syserror (s_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; +} + +SCM_PROC (s_getproto, "getproto", 0, 1, 0, scm_getproto); + +SCM +scm_getproto (name) + SCM name; +{ + SCM ans; + SCM *ve; + struct protoent *entry; + + 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 + { + unsigned long protonum; + protonum = scm_num2ulong (name, (char *) SCM_ARG1, s_getproto); + SCM_DEFER_INTS; + entry = getprotobynumber (protonum); + } + SCM_ALLOW_INTS; + if (!entry) + scm_syserror (s_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; +} + + +static SCM scm_return_entry SCM_P ((struct servent *entry)); + +static SCM +scm_return_entry (entry) + struct servent *entry; +{ + SCM ans; + SCM *ve; + + 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_ALLOW_INTS; + return ans; +} + +SCM_PROC (s_getserv, "getserv", 0, 2, 0, scm_getserv); + +SCM +scm_getserv (name, proto) + SCM name; + SCM proto; +{ + struct servent *entry; + if (SCM_UNBNDP (name)) + { + SCM_DEFER_INTS; + entry = getservent (); + if (!entry) + scm_syserror (s_getserv); + return scm_return_entry (entry); + } + SCM_ASSERT (SCM_NIMP (proto) && SCM_STRINGP (proto), proto, SCM_ARG2, s_getserv); + if (SCM_NIMP (name) && SCM_STRINGP (name)) + { + SCM_DEFER_INTS; + entry = getservbyname (SCM_CHARS (name), SCM_CHARS (proto)); + } + else + { + SCM_ASSERT (SCM_INUMP (name), name, SCM_ARG1, s_getserv); + SCM_DEFER_INTS; + entry = getservbyport (SCM_INUM (name), SCM_CHARS (proto)); + } + if (!entry) + scm_syserror (s_getserv); + return scm_return_entry (entry); +} + +SCM_PROC (s_sethost, "sethost", 0, 1, 0, scm_sethost); + +SCM +scm_sethost (arg) + SCM arg; +{ + if (SCM_UNBNDP (arg)) + endhostent (); + else + sethostent (SCM_NFALSEP (arg)); + return SCM_UNSPECIFIED; +} + +SCM_PROC (s_setnet, "setnet", 0, 1, 0, scm_setnet); + +SCM +scm_setnet (arg) + SCM arg; +{ + if (SCM_UNBNDP (arg)) + endnetent (); + else + setnetent (SCM_NFALSEP (arg)); + return SCM_UNSPECIFIED; +} + +SCM_PROC (s_setproto, "setproto", 0, 1, 0, scm_setproto); + +SCM +scm_setproto (arg) + SCM arg; +{ + if (SCM_UNBNDP (arg)) + endprotoent (); + else + setprotoent (SCM_NFALSEP (arg)); + return SCM_UNSPECIFIED; +} + +SCM_PROC (s_setserv, "setserv", 0, 1, 0, scm_setserv); + +SCM +scm_setserv (arg) + SCM arg; +{ + if (SCM_UNBNDP (arg)) + endservent (); + else + setservent (SCM_NFALSEP (arg)); + return SCM_UNSPECIFIED; +} + + +void +scm_init_net_db () +{ +#ifdef INADDR_ANY + scm_sysintern ("INADDR_ANY", scm_ulong2num (INADDR_ANY)); +#endif +#ifdef INADDR_BROADCAST + scm_sysintern ("INADDR_BROADCAST", scm_ulong2num (INADDR_BROADCAST)); +#endif +#ifdef INADDR_NONE + scm_sysintern ("INADDR_NONE", scm_ulong2num (INADDR_NONE)); +#endif +#ifdef INADDR_LOOPBACK + scm_sysintern ("INADDR_LOOPBACK", scm_ulong2num (INADDR_LOOPBACK)); +#endif + + scm_add_feature ("net-db"); +#include "net_db.x" +} + + diff --git a/libguile/net_db.h b/libguile/net_db.h new file mode 100644 index 000000000..cbef2a711 --- /dev/null +++ b/libguile/net_db.h @@ -0,0 +1,69 @@ +/* classes: h_files */ + +#ifndef NETDBH +#define NETDBH +/* Copyright (C) 1995 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 + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + */ + + +#include "libguile/__scm.h" + + + + + + +extern SCM scm_gethost SCM_P ((SCM name)); +extern SCM scm_inet_aton SCM_P ((SCM address)); +extern SCM scm_inet_ntoa SCM_P ((SCM inetid)); +extern SCM scm_inet_netof SCM_P ((SCM address)); +extern SCM scm_lnaof SCM_P ((SCM address)); +extern SCM scm_inet_makeaddr SCM_P ((SCM net, SCM lna)); +extern SCM scm_getnet SCM_P ((SCM name)); +extern SCM scm_getproto SCM_P ((SCM name)); +extern SCM scm_getserv SCM_P ((SCM name, SCM proto)); +extern SCM scm_sethost SCM_P ((SCM arg)); +extern SCM scm_setnet SCM_P ((SCM arg)); +extern SCM scm_setproto SCM_P ((SCM arg)); +extern SCM scm_setserv SCM_P ((SCM arg)); +extern void scm_init_netdb SCM_P ((void)); + +#endif /* NETDBH */ 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" } - diff --git a/libguile/socket.h b/libguile/socket.h index b87afb18f..16df43ba6 100644 --- a/libguile/socket.h +++ b/libguile/socket.h @@ -49,21 +49,24 @@ + -extern SCM scm_sys_gethost SCM_P ((SCM name)); -extern SCM scm_sys_inet_aton SCM_P ((SCM address)); -extern SCM scm_inet_ntoa SCM_P ((SCM inetid)); -extern SCM scm_inet_netof SCM_P ((SCM address)); -extern SCM scm_lnaof SCM_P ((SCM address)); -extern SCM scm_inet_makeaddr SCM_P ((SCM net, SCM lna)); -extern SCM scm_sys_getnet SCM_P ((SCM name)); -extern SCM scm_sys_getproto SCM_P ((SCM name)); -extern SCM scm_sys_getserv SCM_P ((SCM name, SCM proto)); -extern SCM scm_sethost SCM_P ((SCM arg)); -extern SCM scm_setnet SCM_P ((SCM arg)); -extern SCM scm_setproto SCM_P ((SCM arg)); -extern SCM scm_setserv SCM_P ((SCM arg)); +extern SCM scm_socket SCM_P ((SCM family, SCM style, SCM proto)); +extern SCM scm_socketpair SCM_P ((SCM family, SCM style, SCM proto)); +extern SCM scm_getsockopt SCM_P ((SCM sfd, SCM level, SCM optname)); +extern SCM scm_setsockopt SCM_P ((SCM sfd, SCM level, SCM optname, SCM value)); +extern SCM scm_shutdown SCM_P ((SCM sfd, SCM how)); +extern SCM scm_connect SCM_P ((SCM sockfd, SCM fam, SCM address, SCM args)); +extern SCM scm_bind SCM_P ((SCM sockfd, SCM fam, SCM address, SCM args)); +extern SCM scm_listen SCM_P ((SCM sfd, SCM backlog)); +extern SCM scm_accept SCM_P ((SCM sockfd)); +extern SCM scm_getsockname SCM_P ((SCM sockfd)); +extern SCM scm_getpeername SCM_P ((SCM sockfd)); +extern SCM scm_recv SCM_P ((SCM sockfd, SCM buff_or_size, SCM flags)); +extern SCM scm_send SCM_P ((SCM sockfd, SCM message, SCM flags)); +extern SCM scm_recvfrom SCM_P ((SCM sockfd, SCM buff_or_size, SCM flags)); +extern SCM scm_sendto SCM_P ((SCM sockfd, SCM message, SCM fam, SCM address, SCM args_and_flags)); extern void scm_init_socket SCM_P ((void)); #endif /* SOCKETH */ |