/* "net_db.c" network database support
- * Copyright (C) 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
+ * Copyright (C) 1995, 1996, 1997, 1998, 1999 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
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */
+/* 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.
* 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 "_scm.h"
#include "feature.h"
+#include "scm_validate.h"
#include "net_db.h"
#ifdef HAVE_STRING_H
#include <netinet/in.h>
#include <arpa/inet.h>
-/* Some systems do not declare this. It seems unlikely to produce a
- conflict. */
+/* Some systems do not declare this. Some systems do declare it, as a
+ macro. */
+#ifndef h_errno
extern int h_errno;
+#endif
\f
extern int inet_aton ();
-SCM_PROC (s_inet_aton, "inet-aton", 1, 0, 0, scm_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
+dotted decimal notation into an integer.
-SCM
-scm_inet_aton (address)
- SCM address;
+@smalllisp
+(inet-aton "127.0.0.1") @result{} 2130706433
+
+@end smalllisp")
+#define FUNC_NAME s_scm_inet_aton
{
struct in_addr soka;
- SCM_ASSERT (SCM_NIMP (address) && SCM_ROSTRINGP (address), address, SCM_ARG1, s_inet_aton);
+ 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_syserror (s_inet_aton);
+ SCM_MISC_ERROR ("bad address", SCM_EOL);
return scm_ulong2num (ntohl (soka.s_addr));
}
+#undef FUNC_NAME
-SCM_PROC (s_inet_ntoa, "inet-ntoa", 1, 0, 0, scm_inet_ntoa);
+SCM_DEFINE (scm_inet_ntoa, "inet-ntoa", 1, 0, 0,
+ (SCM inetid),
+"Converts an integer Internet host address into a string with the
+traditional dotted decimal representation.
-SCM
-scm_inet_ntoa (inetid)
- SCM inetid;
+@smalllisp
+(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 (inetid, (char *) SCM_ARG1, s_inet_ntoa));
- SCM_DEFER_INTS;
+ addr.s_addr = htonl (SCM_NUM2ULONG (1,inetid));
s = inet_ntoa (addr);
answer = scm_makfromstr (s, strlen (s), 0);
- SCM_ALLOW_INTS;
return answer;
}
+#undef FUNC_NAME
#ifdef HAVE_INET_NETOF
-SCM_PROC (s_inet_netof, "inet-netof", 1, 0, 0, scm_inet_netof);
-
-SCM
-scm_inet_netof (address)
- SCM address;
+SCM_DEFINE (scm_inet_netof, "inet-netof", 1, 0, 0,
+ (SCM address),
+"Returns the network number part of the given integer Internet address.
+
+@smalllisp
+(inet-netof 2130706433) @result{} 127
+@end smalllisp")
+#define FUNC_NAME s_scm_inet_netof
{
struct in_addr addr;
- addr.s_addr = htonl (scm_num2ulong (address, (char *) SCM_ARG1, s_inet_netof));
+ addr.s_addr = htonl (SCM_NUM2ULONG (1,address));
return scm_ulong2num ((unsigned long) inet_netof (addr));
}
+#undef FUNC_NAME
#endif
#ifdef HAVE_INET_LNAOF
-SCM_PROC (s_lnaof, "inet-lnaof", 1, 0, 0, scm_lnaof);
-
-SCM
-scm_lnaof (address)
- SCM address;
+SCM_DEFINE (scm_lnaof, "inet-lnaof", 1, 0, 0,
+ (SCM address),
+"Returns the local-address-with-network part of the given Internet
+address.
+
+@smalllisp
+(inet-lnaof 2130706433) @result{} 1
+@end smalllisp")
+#define FUNC_NAME s_scm_lnaof
{
struct in_addr addr;
- addr.s_addr = htonl (scm_num2ulong (address, (char *) SCM_ARG1, s_lnaof));
+ addr.s_addr = htonl (SCM_NUM2ULONG (1,address));
return scm_ulong2num ((unsigned long) inet_lnaof (addr));
}
+#undef FUNC_NAME
#endif
#ifdef HAVE_INET_MAKEADDR
-SCM_PROC (s_inet_makeaddr, "inet-makeaddr", 2, 0, 0, scm_inet_makeaddr);
-
-SCM
-scm_inet_makeaddr (net, lna)
- SCM net;
- SCM lna;
+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}
+with the local-address-within-network number @var{lna}.
+
+@smalllisp
+(inet-makeaddr 127 1) @result{} 2130706433
+@end smalllisp")
+#define FUNC_NAME s_scm_inet_makeaddr
{
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);
+#ifdef 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
#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");
+SCM_SYMBOL (scm_no_data_key, "no-data");
-/* !!! Doesn't take address format.
- * Assumes hostent stream isn't reused.
- */
+static void scm_resolv_error (const char *subr, SCM bad_value)
+{
+ if (h_errno == NETDB_INTERNAL)
+ {
+ /* errno supposedly contains a useful value. */
+ scm_syserror (subr);
+ }
+ else
+ {
+ SCM key;
+ const char *errmsg;
+
+ switch (h_errno)
+ {
+ case HOST_NOT_FOUND:
+ key = scm_host_not_found_key;
+ errmsg = "Unknown host";
+ break;
+ case TRY_AGAIN:
+ key = scm_try_again_key;
+ errmsg = "Host name lookup failure";
+ break;
+ case NO_RECOVERY:
+ key = scm_no_recovery_key;
+ errmsg = "Unknown server error";
+ break;
+ case NO_DATA:
+ key = scm_no_data_key;
+ errmsg = "No address associated with name";
+ break;
+ default:
+ scm_misc_error (subr, "Unknown resolver error", SCM_EOL);
+ errmsg = NULL;
+ }
-SCM_PROC (s_gethost, "gethost", 0, 1, 0, scm_gethost);
+#ifdef HAVE_HSTRERROR
+ errmsg = hstrerror (h_errno);
+#endif
+ scm_error (key, subr, errmsg, scm_cons (bad_value, SCM_EOL), SCM_EOL);
+ }
+}
+
+/* Should take an extra arg for address format (will be needed for IPv6).
+ Should use reentrant facilities if available.
+ */
-SCM
-scm_gethost (name)
- SCM name;
+SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
+ (SCM name),
+"@deffnx procedure gethostbyname hostname
+@deffnx procedure gethostbyaddr address
+Look up a host by name or address, returning a host object. The
+@code{gethost} procedure will accept either a string name or an integer
+address; if given no arguments, it behaves like @code{gethostent} (see
+below). If a name or address is supplied but the address can not be
+found, an error will be thrown to one of the keys:
+@code{host-not-found}, @code{try-again}, @code{no-recovery} or
+@code{no-data}, corresponding to the equivalent @code{h_error} values.
+Unusual conditions may result in errors thrown to the
+@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);
int i = 0;
if (SCM_UNBNDP (name))
{
- SCM_DEFER_INTS;
#ifdef HAVE_GETHOSTENT
entry = gethostent ();
#else
afterwards doesn't cut it, because, on Linux, it seems to
try to contact some other server (YP?) and fails, which
is a benign failure. */
- SCM_ALLOW_INTS;
return SCM_BOOL_F;
}
}
- else if (SCM_NIMP (name) && SCM_ROSTRINGP (name))
+ else if (SCM_ROSTRINGP (name))
{
SCM_COERCE_SUBSTR (name);
- SCM_DEFER_INTS;
entry = gethostbyname (SCM_ROCHARS (name));
}
else
{
- inad.s_addr = htonl (scm_num2ulong (name, (char *) SCM_ARG1, s_gethost));
- SCM_DEFER_INTS;
+ inad.s_addr = htonl (SCM_NUM2ULONG (1,name));
entry = gethostbyaddr ((char *) &inad, sizeof (inad), AF_INET);
}
- SCM_ALLOW_INTS;
if (!entry)
- {
- char *errmsg;
- SCM args;
- args = scm_listify (name, SCM_UNDEFINED);
- switch (h_errno)
- {
- case HOST_NOT_FOUND: errmsg = "host %s not found"; break;
- case TRY_AGAIN: errmsg = "nameserver failure (try later)"; break;
- case NO_RECOVERY: errmsg = "non-recoverable error"; break;
- case NO_DATA: errmsg = "no address associated with %s"; break;
- default: errmsg = "undefined error"; break;
- }
- scm_syserror_msg (s_gethost, errmsg, args, h_errno);
- }
- ve[0] = scm_makfromstr (entry->h_name, (scm_sizet) strlen (entry->h_name), 0);
+ scm_resolv_error (FUNC_NAME, name);
+
+ 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);
ve[4] = lst;
return ans;
}
+#undef FUNC_NAME
/* In all subsequent getMUMBLE functions, when we're called with no
operation?), but it seems to work okay. We'll see. */
#if defined(HAVE_GETNETENT) && defined(HAVE_GETNETBYNAME) && defined(HAVE_GETNETBYADDR)
-SCM_PROC (s_getnet, "getnet", 0, 1, 0, scm_getnet);
-
-SCM
-scm_getnet (name)
- SCM name;
+SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0,
+ (SCM name),
+"@deffnx procedure getnetbyname net-name
+@deffnx procedure getnetbyaddr net-number
+Look up a network by name or net number in the network database. The
+@var{net-name} argument must be a string, and the @var{net-number}
+argument must be an integer. @code{getnet} will accept either type of
+argument, behaving like @code{getnetent} (see below) if no arguments are
+given.")
+#define FUNC_NAME s_scm_getnet
{
SCM ans;
SCM *ve;
ve = SCM_VELTS (ans);
if (SCM_UNBNDP (name))
{
- SCM_DEFER_INTS;
errno = 0;
entry = getnetent ();
if (! entry)
{
- SCM_ALLOW_INTS;
if (errno)
- scm_syserror (s_getnet);
+ SCM_SYSERROR;
else
return SCM_BOOL_F;
}
}
- else if (SCM_NIMP (name) && SCM_ROSTRINGP (name))
+ else if (SCM_ROSTRINGP (name))
{
SCM_COERCE_SUBSTR (name);
- SCM_DEFER_INTS;
entry = getnetbyname (SCM_ROCHARS (name));
}
else
{
unsigned long netnum;
- netnum = scm_num2ulong (name, (char *) SCM_ARG1, s_getnet);
- SCM_DEFER_INTS;
+ netnum = SCM_NUM2ULONG (1, name);
entry = getnetbyaddr (netnum, AF_INET);
}
- SCM_ALLOW_INTS;
if (!entry)
- scm_syserror_msg (s_getnet, "no such network %s",
+ 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[3] = scm_ulong2num (entry->n_net + 0L);
return ans;
}
+#undef FUNC_NAME
#endif
#ifdef HAVE_GETPROTOENT
-SCM_PROC (s_getproto, "getproto", 0, 1, 0, scm_getproto);
-
-SCM
-scm_getproto (name)
- SCM name;
+SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
+ (SCM name),
+"@deffnx procedure getprotobyname name
+@deffnx procedure getprotobynumber number
+Look up a network protocol by name or by number. @code{getprotobyname}
+takes a string argument, and @code{getprotobynumber} takes an integer
+argument. @code{getproto} will accept either type, behaving like
+@code{getprotoent} (see below) if no arguments are supplied.")
+#define FUNC_NAME s_scm_getproto
{
SCM ans;
SCM *ve;
ve = SCM_VELTS (ans);
if (SCM_UNBNDP (name))
{
- SCM_DEFER_INTS;
errno = 0;
entry = getprotoent ();
if (! entry)
{
- SCM_ALLOW_INTS;
if (errno)
- scm_syserror (s_getproto);
+ SCM_SYSERROR;
else
return SCM_BOOL_F;
}
}
- else if (SCM_NIMP (name) && SCM_ROSTRINGP (name))
+ else if (SCM_ROSTRINGP (name))
{
SCM_COERCE_SUBSTR (name);
- SCM_DEFER_INTS;
entry = getprotobyname (SCM_ROCHARS (name));
}
else
{
unsigned long protonum;
- protonum = scm_num2ulong (name, (char *) SCM_ARG1, s_getproto);
- SCM_DEFER_INTS;
+ protonum = SCM_NUM2ULONG (1,name);
entry = getprotobynumber (protonum);
}
- SCM_ALLOW_INTS;
if (!entry)
- scm_syserror_msg (s_getproto, "no such protocol %s",
+ 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;
}
+#undef FUNC_NAME
#endif
-static SCM scm_return_entry SCM_P ((struct servent *entry));
-
static SCM
-scm_return_entry (entry)
- struct servent *entry;
+scm_return_entry (struct servent *entry)
{
SCM ans;
SCM *ve;
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;
}
#ifdef HAVE_GETSERVENT
-SCM_PROC (s_getserv, "getserv", 0, 2, 0, scm_getserv);
-
-SCM
-scm_getserv (name, proto)
- SCM name;
- SCM proto;
+SCM_DEFINE (scm_getserv, "getserv", 0, 2, 0,
+ (SCM name, SCM proto),
+"@deffnx procedure getservbyname name protocol
+@deffnx procedure getservbyport port protocol
+Look up a network service by name or by service number, and return a
+network service object. The @var{protocol} argument specifies the name
+of the desired protocol; if the protocol found in the network service
+database does not match this name, a system error is signalled.
+
+The @code{getserv} procedure will take either a service name or number
+as its first argument; if given no arguments, it behaves like
+@code{getservent} (see below).")
+#define FUNC_NAME s_scm_getserv
{
struct servent *entry;
if (SCM_UNBNDP (name))
{
- SCM_DEFER_INTS;
errno = 0;
entry = getservent ();
- SCM_ALLOW_INTS;
if (!entry)
{
if (errno)
- scm_syserror (s_getserv);
+ SCM_SYSERROR;
else
return SCM_BOOL_F;
}
return scm_return_entry (entry);
}
- SCM_ASSERT (SCM_NIMP (proto) && SCM_ROSTRINGP (proto), proto, SCM_ARG2, s_getserv);
+ SCM_VALIDATE_ROSTRING (2,proto);
SCM_COERCE_SUBSTR (proto);
- if (SCM_NIMP (name) && SCM_ROSTRINGP (name))
+ if (SCM_ROSTRINGP (name))
{
SCM_COERCE_SUBSTR (name);
- SCM_DEFER_INTS;
entry = getservbyname (SCM_ROCHARS (name), SCM_ROCHARS (proto));
}
else
{
- SCM_ASSERT (SCM_INUMP (name), name, SCM_ARG1, s_getserv);
- SCM_DEFER_INTS;
+ SCM_VALIDATE_INUM (1,name);
entry = getservbyport (htons (SCM_INUM (name)), SCM_ROCHARS (proto));
}
if (!entry)
- scm_syserror_msg (s_getserv, "no such service %s",
- scm_listify (name, SCM_UNDEFINED), errno);
- SCM_ALLOW_INTS;
+ SCM_SYSERROR_MSG("no such service ~A",
+ scm_listify (name, SCM_UNDEFINED), errno);
return scm_return_entry (entry);
}
+#undef FUNC_NAME
#endif
#if defined(HAVE_SETHOSTENT) && defined(HAVE_ENDHOSTENT)
-SCM_PROC (s_sethost, "sethost", 0, 1, 0, scm_sethost);
-
-SCM
-scm_sethost (arg)
- SCM arg;
+SCM_DEFINE (scm_sethost, "sethost", 0, 1, 0,
+ (SCM arg),
+"If @var{stayopen} is omitted, this is equivalent to @code{endhostent}.
+Otherwise it is equivalent to @code{sethostent stayopen}.")
+#define FUNC_NAME s_scm_sethost
{
if (SCM_UNBNDP (arg))
endhostent ();
sethostent (SCM_NFALSEP (arg));
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
#endif
#if defined(HAVE_SETNETENT) && defined(HAVE_ENDNETENT)
-SCM_PROC (s_setnet, "setnet", 0, 1, 0, scm_setnet);
-
-SCM
-scm_setnet (arg)
- SCM arg;
+SCM_DEFINE (scm_setnet, "setnet", 0, 1, 0,
+ (SCM arg),
+"If @var{stayopen} is omitted, this is equivalent to @code{endnetent}.
+Otherwise it is equivalent to @code{setnetent stayopen}.")
+#define FUNC_NAME s_scm_setnet
{
if (SCM_UNBNDP (arg))
endnetent ();
setnetent (SCM_NFALSEP (arg));
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
#endif
#if defined(HAVE_SETPROTOENT) && defined(HAVE_ENDPROTOENT)
-SCM_PROC (s_setproto, "setproto", 0, 1, 0, scm_setproto);
-
-SCM
-scm_setproto (arg)
- SCM arg;
+SCM_DEFINE (scm_setproto, "setproto", 0, 1, 0,
+ (SCM arg),
+"If @var{stayopen} is omitted, this is equivalent to @code{endprotoent}.
+Otherwise it is equivalent to @code{setprotoent stayopen}.")
+#define FUNC_NAME s_scm_setproto
{
if (SCM_UNBNDP (arg))
endprotoent ();
setprotoent (SCM_NFALSEP (arg));
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
#endif
#if defined(HAVE_SETSERVENT) && defined(HAVE_ENDSERVENT)
-SCM_PROC (s_setserv, "setserv", 0, 1, 0, scm_setserv);
-
-SCM
-scm_setserv (arg)
- SCM arg;
+SCM_DEFINE (scm_setserv, "setserv", 0, 1, 0,
+ (SCM arg),
+"If @var{stayopen} is omitted, this is equivalent to @code{endservent}.
+Otherwise it is equivalent to @code{setservent stayopen}.")
+#define FUNC_NAME s_scm_setserv
{
if (SCM_UNBNDP (arg))
endservent ();
setservent (SCM_NFALSEP (arg));
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
#endif
HCoop / bpt / guile.git / blobdiff