/* "net_db.c" network database support
- * Copyright (C) 1995,1996 Free Software Foundation, Inc.
+ * Copyright (C) 1995,1996,1997 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
*
* 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.
+ * 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.
*
* 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.
- */
+ * 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.
#include <netinet/in.h>
#include <arpa/inet.h>
+/* Some systems do not declare this. It seems unlikely to produce a
+ conflict. */
+extern int h_errno;
+
\f
#ifndef STDC_HEADERS
return answer;
}
+#ifdef HAVE_INET_NETOF
SCM_PROC (s_inet_netof, "inet-netof", 1, 0, 0, scm_inet_netof);
SCM
addr.s_addr = htonl (scm_num2ulong (address, (char *) SCM_ARG1, s_inet_netof));
return scm_ulong2num ((unsigned long) inet_netof (addr));
}
+#endif
+#ifdef HAVE_INET_LNAOF
SCM_PROC (s_lnaof, "inet-lnaof", 1, 0, 0, scm_lnaof);
SCM
addr.s_addr = htonl (scm_num2ulong (address, (char *) SCM_ARG1, s_lnaof));
return scm_ulong2num ((unsigned long) inet_lnaof (addr));
}
+#endif
-
+#ifdef HAVE_INET_MAKEADDR
SCM_PROC (s_inet_makeaddr, "inet-makeaddr", 2, 0, 0, scm_inet_makeaddr);
SCM
addr = inet_makeaddr (netnum, lnanum);
return scm_ulong2num (ntohl (addr.s_addr));
}
+#endif
/* !!! Doesn't take address format.
scm_gethost (name)
SCM name;
{
- SCM ans = scm_make_vector (SCM_MAKINUM (5), SCM_UNSPECIFIED, SCM_BOOL_F);
+ SCM ans = scm_make_vector (SCM_MAKINUM (5), SCM_UNSPECIFIED);
SCM *ve = SCM_VELTS (ans);
SCM lst = SCM_EOL;
struct hostent *entry;
#else
entry = NULL;
#endif
+ if (! entry)
+ {
+ /* As far as I can tell, there's no good way to tell whether
+ zero means an error or end-of-file. The trick of
+ clearing errno before calling gethostent and checking it
+ 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))
{
+ SCM_COERCE_SUBSTR (name);
SCM_DEFER_INTS;
entry = gethostbyname (SCM_ROCHARS (name));
}
}
SCM_ALLOW_INTS;
if (!entry)
- scm_syserror (s_gethost);
+ {
+ 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);
ve[1] = scm_makfromstrs (-1, entry->h_aliases);
ve[2] = SCM_MAKINUM (entry->h_addrtype + 0L);
}
+/* In all subsequent getMUMBLE functions, when we're called with no
+ arguments, we're supposed to traverse the tables entry by entry.
+ However, there doesn't seem to be any documented way to distinguish
+ between end-of-table and an error; in both cases the functions
+ return zero. Gotta love Unix. For the time being, we clear errno,
+ and if we get a zero and errno is set, we signal an error. This
+ doesn't seem quite right (what if errno gets set as part of healthy
+ 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 *ve;
struct netent *entry;
- ans = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED, SCM_BOOL_F);
+ ans = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED);
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);
+ else
+ return SCM_BOOL_F;
+ }
}
else if (SCM_NIMP (name) && SCM_ROSTRINGP (name))
{
+ SCM_COERCE_SUBSTR (name);
SCM_DEFER_INTS;
entry = getnetbyname (SCM_ROCHARS (name));
}
}
SCM_ALLOW_INTS;
if (!entry)
- scm_syserror (s_getnet);
+ scm_syserror_msg (s_getnet, "no such network %s",
+ 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;
}
+#endif
+#ifdef HAVE_GETPROTOENT
SCM_PROC (s_getproto, "getproto", 0, 1, 0, scm_getproto);
SCM
SCM *ve;
struct protoent *entry;
- ans = scm_make_vector (SCM_MAKINUM (3), SCM_UNSPECIFIED, SCM_BOOL_F);
+ ans = scm_make_vector (SCM_MAKINUM (3), SCM_UNSPECIFIED);
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);
+ else
+ return SCM_BOOL_F;
+ }
}
else if (SCM_NIMP (name) && SCM_ROSTRINGP (name))
{
+ SCM_COERCE_SUBSTR (name);
SCM_DEFER_INTS;
entry = getprotobyname (SCM_ROCHARS (name));
}
}
SCM_ALLOW_INTS;
if (!entry)
- scm_syserror (s_getproto);
+ scm_syserror_msg (s_getproto, "no such protocol %s",
+ 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;
}
-
+#endif
static SCM scm_return_entry SCM_P ((struct servent *entry));
SCM ans;
SCM *ve;
- ans = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED, SCM_BOOL_F);
+ 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);
return ans;
}
+#ifdef HAVE_GETSERVENT
SCM_PROC (s_getserv, "getserv", 0, 2, 0, scm_getserv);
SCM
if (SCM_UNBNDP (name))
{
SCM_DEFER_INTS;
+ errno = 0;
entry = getservent ();
- if (!entry)
- scm_syserror (s_getserv);
SCM_ALLOW_INTS;
+ if (!entry)
+ {
+ if (errno)
+ scm_syserror (s_getserv);
+ else
+ return SCM_BOOL_F;
+ }
return scm_return_entry (entry);
}
SCM_ASSERT (SCM_NIMP (proto) && SCM_ROSTRINGP (proto), proto, SCM_ARG2, s_getserv);
+ SCM_COERCE_SUBSTR (proto);
if (SCM_NIMP (name) && SCM_ROSTRINGP (name))
{
+ SCM_COERCE_SUBSTR (name);
SCM_DEFER_INTS;
entry = getservbyname (SCM_ROCHARS (name), SCM_ROCHARS (proto));
}
entry = getservbyport (htons (SCM_INUM (name)), SCM_ROCHARS (proto));
}
if (!entry)
- scm_syserror (s_getserv);
+ scm_syserror_msg (s_getserv, "no such service %s",
+ scm_listify (name, SCM_UNDEFINED), errno);
SCM_ALLOW_INTS;
return scm_return_entry (entry);
}
+#endif
+#if defined(HAVE_SETHOSTENT) && defined(HAVE_ENDHOSTENT)
SCM_PROC (s_sethost, "sethost", 0, 1, 0, scm_sethost);
SCM
sethostent (SCM_NFALSEP (arg));
return SCM_UNSPECIFIED;
}
+#endif
+#if defined(HAVE_SETNETENT) && defined(HAVE_ENDNETENT)
SCM_PROC (s_setnet, "setnet", 0, 1, 0, scm_setnet);
SCM
setnetent (SCM_NFALSEP (arg));
return SCM_UNSPECIFIED;
}
+#endif
+#if defined(HAVE_SETPROTOENT) && defined(HAVE_ENDPROTOENT)
SCM_PROC (s_setproto, "setproto", 0, 1, 0, scm_setproto);
SCM
setprotoent (SCM_NFALSEP (arg));
return SCM_UNSPECIFIED;
}
+#endif
+#if defined(HAVE_SETSERVENT) && defined(HAVE_ENDSERVENT)
SCM_PROC (s_setserv, "setserv", 0, 1, 0, scm_setserv);
SCM
setservent (SCM_NFALSEP (arg));
return SCM_UNSPECIFIED;
}
+#endif
void
scm_add_feature ("net-db");
#include "net_db.x"
}
-
-
HCoop / bpt / guile.git / blobdiff