X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/e282f286ebae78ac771550b65b04778807ded258..a89cafc0562942680db63fe8ddf89f466ba2f7af:/libguile/net_db.c diff --git a/libguile/net_db.c b/libguile/net_db.c index 3117f6764..af6e3d5f4 100644 --- a/libguile/net_db.c +++ b/libguile/net_db.c @@ -1,47 +1,21 @@ /* "net_db.c" network database support - * Copyright (C) 1995, 96, 97, 98, 99, 2000 Free Software Foundation, Inc. + * Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2009 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, Inc., 59 Temple Place, Suite 330, - * Boston, MA 02111-1307 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 library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. * - * 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. + * This library 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 + * Lesser General Public License for more details. * - * 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. */ + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + */ -/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999, - gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */ /* Written in 1994 by Aubrey Jaffer. @@ -51,137 +25,53 @@ */ -#include -#include "_scm.h" -#include "feature.h" +#ifdef HAVE_CONFIG_H +# include +#endif + +#include + +#include "libguile/_scm.h" +#include "libguile/feature.h" +#include "libguile/strings.h" +#include "libguile/vectors.h" +#include "libguile/dynwind.h" -#include "validate.h" -#include "net_db.h" +#include "libguile/validate.h" +#include "libguile/net_db.h" #ifdef HAVE_STRING_H #include #endif #include + +#ifdef HAVE_WINSOCK2_H +#include +#else #include #include #include #include - -/* Some systems do not declare this. Some systems do declare it, as a - macro. */ -#ifndef h_errno -extern int h_errno; #endif - - -#ifndef STDC_HEADERS -int close (); -#endif /* STDC_HEADERS */ - -extern int inet_aton (); - -SCM_DEFINE (scm_inet_aton, "inet-aton", 1, 0, 0, - (SCM address), - "Converts a string containing an Internet host address in the traditional\n" - "dotted decimal notation into an integer.\n\n" - "@smalllisp\n" - "(inet-aton \"127.0.0.1\") @result{} 2130706433\n\n" - "@end smalllisp") -#define FUNC_NAME s_scm_inet_aton -{ - struct in_addr soka; - - SCM_VALIDATE_ROSTRING (1,address); - if (SCM_SUBSTRP (address)) - address = scm_makfromstr (SCM_ROCHARS (address), SCM_ROLENGTH (address), 0); - if (inet_aton (SCM_ROCHARS (address), &soka) == 0) - SCM_MISC_ERROR ("bad address", SCM_EOL); - return scm_ulong2num (ntohl (soka.s_addr)); -} -#undef FUNC_NAME - - -SCM_DEFINE (scm_inet_ntoa, "inet-ntoa", 1, 0, 0, - (SCM inetid), - "Converts an integer Internet host address into a string with the\n" - "traditional dotted decimal representation.\n\n" - "@smalllisp\n" - "(inet-ntoa 2130706433) @result{} \"127.0.0.1\"" - "@end smalllisp") -#define FUNC_NAME s_scm_inet_ntoa -{ - struct in_addr addr; - char *s; - SCM answer; - addr.s_addr = htonl (SCM_NUM2ULONG (1,inetid)); - s = inet_ntoa (addr); - answer = scm_makfromstr (s, strlen (s), 0); - return answer; -} -#undef FUNC_NAME - -#ifdef HAVE_INET_NETOF -SCM_DEFINE (scm_inet_netof, "inet-netof", 1, 0, 0, - (SCM address), - "Returns the network number part of the given integer Internet address.\n\n" - "@smalllisp\n" - "(inet-netof 2130706433) @result{} 127\n" - "@end smalllisp") -#define FUNC_NAME s_scm_inet_netof -{ - struct in_addr addr; - addr.s_addr = htonl (SCM_NUM2ULONG (1,address)); - return scm_ulong2num ((unsigned long) inet_netof (addr)); -} -#undef FUNC_NAME +#ifdef __MINGW32__ +#include "win32-socket.h" #endif -#ifdef HAVE_INET_LNAOF -SCM_DEFINE (scm_lnaof, "inet-lnaof", 1, 0, 0, - (SCM address), - "Returns the local-address-with-network part of the given Internet\n" - "address.\n\n" - "@smalllisp\n" - "(inet-lnaof 2130706433) @result{} 1\n" - "@end smalllisp") -#define FUNC_NAME s_scm_lnaof -{ - struct in_addr addr; - addr.s_addr = htonl (SCM_NUM2ULONG (1,address)); - return scm_ulong2num ((unsigned long) inet_lnaof (addr)); -} -#undef FUNC_NAME +#if !defined (HAVE_H_ERRNO) && !defined (__MINGW32__) && !defined (__CYGWIN__) +/* h_errno not found in netdb.h, maybe this will help. */ +extern int h_errno; #endif -#ifdef HAVE_INET_MAKEADDR -SCM_DEFINE (scm_inet_makeaddr, "inet-makeaddr", 2, 0, 0, - (SCM net, SCM lna), - "Makes an Internet host address by combining the network number @var{net}\n" - "with the local-address-within-network number @var{lna}.\n\n" - "@smalllisp\n" - "(inet-makeaddr 127 1) @result{} 2130706433\n" - "@end smalllisp") -#define FUNC_NAME s_scm_inet_makeaddr -{ - struct in_addr addr; - unsigned long netnum; - unsigned long lnanum; - -#if 0 /* GJB:FIXME:: */ - SCM_VALIDATE_INUM_COPY (1,net,netnum); - SCM_VALIDATE_INUM_COPY (2,lna,lnanum); -#else - netnum = SCM_NUM2ULONG (1, net); - lnanum = SCM_NUM2ULONG (2, lna); -#endif - addr = inet_makeaddr (netnum, lnanum); - return scm_ulong2num (ntohl (addr.s_addr)); -} -#undef FUNC_NAME +#if defined HAVE_HSTRERROR && !HAVE_DECL_HSTRERROR \ + && !defined __MINGW32__ && !defined __CYGWIN__ +/* Some OSes, such as Tru64 5.1b, lack a declaration for hstrerror(3). */ +extern const char *hstrerror (int); #endif + + SCM_SYMBOL (scm_host_not_found_key, "host-not-found"); SCM_SYMBOL (scm_try_again_key, "try-again"); SCM_SYMBOL (scm_no_recovery_key, "no-recovery"); @@ -189,12 +79,14 @@ SCM_SYMBOL (scm_no_data_key, "no-data"); static void scm_resolv_error (const char *subr, SCM bad_value) { +#ifdef NETDB_INTERNAL if (h_errno == NETDB_INTERNAL) { /* errno supposedly contains a useful value. */ scm_syserror (subr); } else +#endif { SCM key; const char *errmsg; @@ -225,7 +117,7 @@ static void scm_resolv_error (const char *subr, SCM bad_value) #ifdef HAVE_HSTRERROR errmsg = (const char *) hstrerror (h_errno); #endif - scm_error (key, subr, errmsg, scm_cons (bad_value, SCM_EOL), SCM_EOL); + scm_error (key, subr, errmsg, SCM_BOOL_F, SCM_EOL); } } @@ -234,9 +126,9 @@ static void scm_resolv_error (const char *subr, SCM bad_value) */ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0, - (SCM name), - "@deffnx procedure gethostbyname hostname\n" - "@deffnx procedure gethostbyaddr address\n" + (SCM host), + "@deffnx {Scheme Procedure} gethostbyname hostname\n" + "@deffnx {Scheme Procedure} gethostbyaddr address\n" "Look up a host by name or address, returning a host object. The\n" "@code{gethost} procedure will accept either a string name or an integer\n" "address; if given no arguments, it behaves like @code{gethostent} (see\n" @@ -248,14 +140,14 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0, "@code{system-error} or @code{misc_error} keys.") #define FUNC_NAME s_scm_gethost { - SCM ans = scm_make_vector (SCM_MAKINUM (5), SCM_UNSPECIFIED); - SCM *ve = SCM_VELTS (ans); + SCM result = scm_c_make_vector (5, SCM_UNSPECIFIED); SCM lst = SCM_EOL; struct hostent *entry; struct in_addr inad; char **argv; int i = 0; - if (SCM_UNBNDP (name)) + + if (SCM_UNBNDP (host)) { #ifdef HAVE_GETHOSTENT entry = gethostent (); @@ -273,37 +165,38 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0, return SCM_BOOL_F; } } - else if (SCM_ROSTRINGP (name)) + else if (scm_is_string (host)) { - SCM_COERCE_SUBSTR (name); - entry = gethostbyname (SCM_ROCHARS (name)); + char *str = scm_to_locale_string (host); + entry = gethostbyname (str); + free (str); } else { - inad.s_addr = htonl (SCM_NUM2ULONG (1,name)); + inad.s_addr = htonl (scm_to_ulong (host)); entry = gethostbyaddr ((char *) &inad, sizeof (inad), AF_INET); } + if (!entry) - scm_resolv_error (FUNC_NAME, name); + scm_resolv_error (FUNC_NAME, host); - 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); + SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->h_name)); + SCM_SIMPLE_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->h_aliases)); + SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_int (entry->h_addrtype)); + SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_int (entry->h_length)); if (sizeof (struct in_addr) != entry->h_length) { - ve[4] = SCM_BOOL_F; - return ans; + SCM_SIMPLE_VECTOR_SET(result, 4, SCM_BOOL_F); + return result; } 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); + lst = scm_cons (scm_from_ulong (ntohl (inad.s_addr)), lst); } - ve[4] = lst; - return ans; + SCM_SIMPLE_VECTOR_SET(result, 4, lst); + return result; } #undef FUNC_NAME @@ -319,9 +212,9 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0, #if defined(HAVE_GETNETENT) && defined(HAVE_GETNETBYNAME) && defined(HAVE_GETNETBYADDR) SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0, - (SCM name), - "@deffnx procedure getnetbyname net-name\n" - "@deffnx procedure getnetbyaddr net-number\n" + (SCM net), + "@deffnx {Scheme Procedure} getnetbyname net-name\n" + "@deffnx {Scheme Procedure} getnetbyaddr net-number\n" "Look up a network by name or net number in the network database. The\n" "@var{net-name} argument must be a string, and the @var{net-number}\n" "argument must be an integer. @code{getnet} will accept either type of\n" @@ -329,118 +222,115 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0, "given.") #define FUNC_NAME s_scm_getnet { - SCM ans; - SCM *ve; + SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED); struct netent *entry; + int eno; - ans = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED); - ve = SCM_VELTS (ans); - if (SCM_UNBNDP (name)) + if (SCM_UNBNDP (net)) { - errno = 0; entry = getnetent (); if (! entry) { - if (errno) - SCM_SYSERROR; - else - return SCM_BOOL_F; + /* There's no good way to tell whether zero means an error + or end-of-file, so we always return #f. See `gethost' + for details. */ + return SCM_BOOL_F; } } - else if (SCM_ROSTRINGP (name)) + else if (scm_is_string (net)) { - SCM_COERCE_SUBSTR (name); - entry = getnetbyname (SCM_ROCHARS (name)); + char *str = scm_to_locale_string (net); + entry = getnetbyname (str); + eno = errno; + free (str); } else { - unsigned long netnum; - netnum = SCM_NUM2ULONG (1, name); + unsigned long netnum = scm_to_ulong (net); entry = getnetbyaddr (netnum, AF_INET); + eno = errno; } + if (!entry) - SCM_SYSERROR_MSG ("no such network ~A", - scm_listify (name, SCM_UNDEFINED), errno); - 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_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), eno); + + SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->n_name)); + SCM_SIMPLE_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->n_aliases)); + SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_int (entry->n_addrtype)); + SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_ulong (entry->n_net)); + return result; } #undef FUNC_NAME #endif -#ifdef HAVE_GETPROTOENT +#if defined (HAVE_GETPROTOENT) || defined (__MINGW32__) SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0, - (SCM name), - "@deffnx procedure getprotobyname name\n" - "@deffnx procedure getprotobynumber number\n" + (SCM protocol), + "@deffnx {Scheme Procedure} getprotobyname name\n" + "@deffnx {Scheme Procedure} getprotobynumber number\n" "Look up a network protocol by name or by number. @code{getprotobyname}\n" "takes a string argument, and @code{getprotobynumber} takes an integer\n" "argument. @code{getproto} will accept either type, behaving like\n" "@code{getprotoent} (see below) if no arguments are supplied.") #define FUNC_NAME s_scm_getproto { - SCM ans; - SCM *ve; + SCM result = scm_c_make_vector (3, SCM_UNSPECIFIED); struct protoent *entry; + int eno; - ans = scm_make_vector (SCM_MAKINUM (3), SCM_UNSPECIFIED); - ve = SCM_VELTS (ans); - if (SCM_UNBNDP (name)) + if (SCM_UNBNDP (protocol)) { - errno = 0; entry = getprotoent (); if (! entry) { - if (errno) - SCM_SYSERROR; - else - return SCM_BOOL_F; + /* There's no good way to tell whether zero means an error + or end-of-file, so we always return #f. See `gethost' + for details. */ + return SCM_BOOL_F; } } - else if (SCM_ROSTRINGP (name)) + else if (scm_is_string (protocol)) { - SCM_COERCE_SUBSTR (name); - entry = getprotobyname (SCM_ROCHARS (name)); + char *str = scm_to_locale_string (protocol); + entry = getprotobyname (str); + eno = errno; + free (str); } else { - unsigned long protonum; - protonum = SCM_NUM2ULONG (1,name); + unsigned long protonum = scm_to_ulong (protocol); entry = getprotobynumber (protonum); + eno = errno; } + if (!entry) - SCM_SYSERROR_MSG ("no such protocol ~A", - scm_listify (name, SCM_UNDEFINED), errno); - 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_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), eno); + + SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->p_name)); + SCM_SIMPLE_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->p_aliases)); + SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_int (entry->p_proto)); + return result; } #undef FUNC_NAME #endif +#if defined (HAVE_GETSERVENT) || defined (__MINGW32__) static SCM scm_return_entry (struct servent *entry) { - SCM ans; - SCM *ve; - - ans = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED); - 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); - return ans; + SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED); + + SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->s_name)); + SCM_SIMPLE_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->s_aliases)); + SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_uint16 (ntohs (entry->s_port))); + SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_locale_string (entry->s_proto)); + return result; } -#ifdef HAVE_GETSERVENT SCM_DEFINE (scm_getserv, "getserv", 0, 2, 0, - (SCM name, SCM proto), - "@deffnx procedure getservbyname name protocol\n" - "@deffnx procedure getservbyport port protocol\n" + (SCM name, SCM protocol), + "@deffnx {Scheme Procedure} getservbyname name protocol\n" + "@deffnx {Scheme Procedure} getservbyport port protocol\n" "Look up a network service by name or by service number, and return a\n" "network service object. The @var{protocol} argument specifies the name\n" "of the desired protocol; if the protocol found in the network service\n" @@ -451,34 +341,44 @@ SCM_DEFINE (scm_getserv, "getserv", 0, 2, 0, #define FUNC_NAME s_scm_getserv { struct servent *entry; + char *protoname; + int eno; + if (SCM_UNBNDP (name)) { - errno = 0; entry = getservent (); if (!entry) { - if (errno) - SCM_SYSERROR; - else - return SCM_BOOL_F; + /* There's no good way to tell whether zero means an error + or end-of-file, so we always return #f. See `gethost' + for details. */ + return SCM_BOOL_F; } return scm_return_entry (entry); } - SCM_VALIDATE_ROSTRING (2,proto); - SCM_COERCE_SUBSTR (proto); - if (SCM_ROSTRINGP (name)) + + scm_dynwind_begin (0); + + protoname = scm_to_locale_string (protocol); + scm_dynwind_free (protoname); + + if (scm_is_string (name)) { - SCM_COERCE_SUBSTR (name); - entry = getservbyname (SCM_ROCHARS (name), SCM_ROCHARS (proto)); + char *str = scm_to_locale_string (name); + entry = getservbyname (str, protoname); + eno = errno; + free (str); } else { - SCM_VALIDATE_INUM (1,name); - entry = getservbyport (htons (SCM_INUM (name)), SCM_ROCHARS (proto)); + entry = getservbyport (htons (scm_to_int (name)), protoname); + eno = errno; } + if (!entry) - SCM_SYSERROR_MSG("no such service ~A", - scm_listify (name, SCM_UNDEFINED), errno); + SCM_SYSERROR_MSG("no such service ~A", scm_list_1 (name), eno); + + scm_dynwind_end (); return scm_return_entry (entry); } #undef FUNC_NAME @@ -486,15 +386,15 @@ SCM_DEFINE (scm_getserv, "getserv", 0, 2, 0, #if defined(HAVE_SETHOSTENT) && defined(HAVE_ENDHOSTENT) SCM_DEFINE (scm_sethost, "sethost", 0, 1, 0, - (SCM arg), + (SCM stayopen), "If @var{stayopen} is omitted, this is equivalent to @code{endhostent}.\n" "Otherwise it is equivalent to @code{sethostent stayopen}.") #define FUNC_NAME s_scm_sethost { - if (SCM_UNBNDP (arg)) + if (SCM_UNBNDP (stayopen)) endhostent (); else - sethostent (SCM_NFALSEP (arg)); + sethostent (scm_is_true (stayopen)); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -502,47 +402,47 @@ SCM_DEFINE (scm_sethost, "sethost", 0, 1, 0, #if defined(HAVE_SETNETENT) && defined(HAVE_ENDNETENT) SCM_DEFINE (scm_setnet, "setnet", 0, 1, 0, - (SCM arg), + (SCM stayopen), "If @var{stayopen} is omitted, this is equivalent to @code{endnetent}.\n" "Otherwise it is equivalent to @code{setnetent stayopen}.") #define FUNC_NAME s_scm_setnet { - if (SCM_UNBNDP (arg)) + if (SCM_UNBNDP (stayopen)) endnetent (); else - setnetent (SCM_NFALSEP (arg)); + setnetent (scm_is_true (stayopen)); return SCM_UNSPECIFIED; } #undef FUNC_NAME #endif -#if defined(HAVE_SETPROTOENT) && defined(HAVE_ENDPROTOENT) +#if defined (HAVE_SETPROTOENT) && defined (HAVE_ENDPROTOENT) || defined (__MINGW32__) SCM_DEFINE (scm_setproto, "setproto", 0, 1, 0, - (SCM arg), + (SCM stayopen), "If @var{stayopen} is omitted, this is equivalent to @code{endprotoent}.\n" "Otherwise it is equivalent to @code{setprotoent stayopen}.") #define FUNC_NAME s_scm_setproto { - if (SCM_UNBNDP (arg)) + if (SCM_UNBNDP (stayopen)) endprotoent (); else - setprotoent (SCM_NFALSEP (arg)); + setprotoent (scm_is_true (stayopen)); return SCM_UNSPECIFIED; } #undef FUNC_NAME #endif -#if defined(HAVE_SETSERVENT) && defined(HAVE_ENDSERVENT) +#if defined (HAVE_SETSERVENT) && defined (HAVE_ENDSERVENT) || defined (__MINGW32__) SCM_DEFINE (scm_setserv, "setserv", 0, 1, 0, - (SCM arg), + (SCM stayopen), "If @var{stayopen} is omitted, this is equivalent to @code{endservent}.\n" "Otherwise it is equivalent to @code{setservent stayopen}.") #define FUNC_NAME s_scm_setserv { - if (SCM_UNBNDP (arg)) + if (SCM_UNBNDP (stayopen)) endservent (); else - setservent (SCM_NFALSEP (arg)); + setservent (scm_is_true (stayopen)); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -552,19 +452,12 @@ SCM_DEFINE (scm_setserv, "setserv", 0, 1, 0, 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" +#include "libguile/net_db.x" } + +/* + Local Variables: + c-file-style: "gnu" + End: +*/