libguile/net_db.c

   1 /* "net_db.c" network database support
   2  * Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2006, 2009,
   3  *   2010, 2011, 2012, 2013 Free Software Foundation, Inc.
   4  *
   5  * This library is free software; you can redistribute it and/or
   6  * modify it under the terms of the GNU Lesser General Public License
   7  * as published by the Free Software Foundation; either version 3 of
   8  * the License, or (at your option) any later version.
   9  *
  10  * This library is distributed in the hope that it will be useful, but
  11  * WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13  * Lesser General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU Lesser General Public
  16  * License along with this library; if not, write to the Free Software
  17  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  18  * 02110-1301 USA
  19  */
  20
  21
  22
  23 /* Written in 1994 by Aubrey Jaffer.
  24  * Thanks to Hallvard.Tretteberg@si.sintef.no for inspiration and discussion.
  25  * Rewritten by Gary Houston to be a closer interface to the C socket library.
  26  * Split into net_db.c and socket.c.
  27  */
  28 \f
  29
  30 #ifdef HAVE_CONFIG_H
  31 #  include <config.h>
  32 #endif
  33
  34 #include <verify.h>
  35 #include <errno.h>
  36
  37 #ifdef HAVE_STRING_H
  38 #include <string.h>
  39 #endif
  40
  41 #include <sys/types.h>
  42
  43 #include <sys/socket.h>
  44 #include <netdb.h>
  45 #include <netinet/in.h>
  46 #include <arpa/inet.h>
  47
  48 #include "libguile/_scm.h"
  49 #include "libguile/feature.h"
  50 #include "libguile/strings.h"
  51 #include "libguile/vectors.h"
  52 #include "libguile/dynwind.h"
  53
  54 #include "libguile/validate.h"
  55 #include "libguile/net_db.h"
  56 #include "libguile/socket.h"
  57
  58
  59 #if defined (HAVE_H_ERRNO)
  60 /* Only wrap gethostbyname / gethostbyaddr if h_errno is available.  */
  61
  62 #if defined HAVE_HSTRERROR && !HAVE_DECL_HSTRERROR
  63 /* Some OSes, such as Tru64 5.1b, lack a declaration for hstrerror(3).  */
  64 extern const char *hstrerror (int);
  65 #endif
  66
  67 SCM_SYMBOL (scm_host_not_found_key, "host-not-found");
  68 SCM_SYMBOL (scm_try_again_key, "try-again");
  69 SCM_SYMBOL (scm_no_recovery_key, "no-recovery");
  70 SCM_SYMBOL (scm_no_data_key, "no-data");
  71
  72 static void scm_resolv_error (const char *subr, SCM bad_value)
  73 {
  74 #ifdef NETDB_INTERNAL
  75   if (h_errno == NETDB_INTERNAL)
  76     {
  77       /* errno supposedly contains a useful value.  */
  78       scm_syserror (subr);
  79     }
  80   else
  81 #endif
  82     {
  83       SCM key;
  84       const char *errmsg;
  85
  86       switch (h_errno)
  87         {
  88         case HOST_NOT_FOUND:
  89           key = scm_host_not_found_key;
  90           errmsg = "Unknown host";
  91           break;
  92         case TRY_AGAIN:
  93           key = scm_try_again_key;
  94           errmsg = "Host name lookup failure";
  95           break;
  96         case NO_RECOVERY:
  97           key = scm_no_recovery_key;
  98           errmsg = "Unknown server error";
  99           break;
 100         case NO_DATA:
 101           key = scm_no_data_key;
 102           errmsg = "No address associated with name";
 103           break;
 104         default:
 105           scm_misc_error (subr, "Unknown resolver error", SCM_EOL);
 106           errmsg = NULL;
 107         }
 108
 109 #ifdef HAVE_HSTRERROR
 110       errmsg = (const char *) hstrerror (h_errno);
 111 #endif
 112       scm_error (key, subr, errmsg, SCM_BOOL_F, SCM_EOL);
 113     }
 114 }
 115
 116 /* Should take an extra arg for address format (will be needed for IPv6).
 117    Should use reentrant facilities if available.
 118  */
 119
 120 SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
 121             (SCM host),
 122             "@deffnx {Scheme Procedure} gethostbyname hostname\n"
 123             "@deffnx {Scheme Procedure} gethostbyaddr address\n"
 124             "Look up a host by name or address, returning a host object.  The\n"
 125             "@code{gethost} procedure will accept either a string name or an integer\n"
 126             "address; if given no arguments, it behaves like @code{gethostent} (see\n"
 127             "below).  If a name or address is supplied but the address can not be\n"
 128             "found, an error will be thrown to one of the keys:\n"
 129             "@code{host-not-found}, @code{try-again}, @code{no-recovery} or\n"
 130             "@code{no-data}, corresponding to the equivalent @code{h_error} values.\n"
 131             "Unusual conditions may result in errors thrown to the\n"
 132             "@code{system-error} or @code{misc_error} keys.")
 133 #define FUNC_NAME s_scm_gethost
 134 {
 135   SCM result = scm_c_make_vector (5, SCM_UNSPECIFIED);
 136   SCM lst = SCM_EOL;
 137   struct hostent *entry;
 138   struct in_addr inad;
 139   char **argv;
 140   int i = 0;
 141
 142   if (SCM_UNBNDP (host))
 143     {
 144 #ifdef HAVE_GETHOSTENT
 145       entry = gethostent ();
 146 #else
 147       entry = NULL;
 148 #endif
 149       if (! entry)
 150         {
 151           /* As far as I can tell, there's no good way to tell whether
 152              zero means an error or end-of-file.  The trick of
 153              clearing errno before calling gethostent and checking it
 154              afterwards doesn't cut it, because, on Linux, it seems to
 155              try to contact some other server (YP?) and fails, which
 156              is a benign failure.  */
 157           return SCM_BOOL_F;
 158         }
 159     }
 160   else if (scm_is_string (host))
 161     {
 162       char *str = scm_to_locale_string (host);
 163       entry = gethostbyname (str);
 164       free (str);
 165     }
 166   else
 167     {
 168       inad.s_addr = htonl (scm_to_ulong (host));
 169       entry = gethostbyaddr ((char *) &inad, sizeof (inad), AF_INET);
 170     }
 171
 172   if (!entry)
 173     scm_resolv_error (FUNC_NAME, host);
 174
 175   SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->h_name));
 176   SCM_SIMPLE_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->h_aliases));
 177   SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_int (entry->h_addrtype));
 178   SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_int (entry->h_length));
 179   if (sizeof (struct in_addr) != entry->h_length)
 180     {
 181       SCM_SIMPLE_VECTOR_SET(result, 4, SCM_BOOL_F);
 182       return result;
 183     }
 184   for (argv = entry->h_addr_list; argv[i]; i++);
 185   while (i--)
 186     {
 187       inad = *(struct in_addr *) argv[i];
 188       lst = scm_cons (scm_from_ulong (ntohl (inad.s_addr)), lst);
 189     }
 190   SCM_SIMPLE_VECTOR_SET(result, 4, lst);
 191   return result;
 192 }
 193 #undef FUNC_NAME
 194
 195 #endif /* HAVE_H_ERRNO */
 196
 197
 198 /* In all subsequent getMUMBLE functions, when we're called with no
 199    arguments, we're supposed to traverse the tables entry by entry.
 200    However, there doesn't seem to be any documented way to distinguish
 201    between end-of-table and an error; in both cases the functions
 202    return zero.  Gotta love Unix.  For the time being, we clear errno,
 203    and if we get a zero and errno is set, we signal an error.  This
 204    doesn't seem quite right (what if errno gets set as part of healthy
 205    operation?), but it seems to work okay.  We'll see.  */
 206
 207 #if defined(HAVE_GETNETENT) && defined(HAVE_GETNETBYNAME) && defined(HAVE_GETNETBYADDR)
 208 SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0,
 209             (SCM net),
 210             "@deffnx {Scheme Procedure} getnetbyname net-name\n"
 211             "@deffnx {Scheme Procedure} getnetbyaddr net-number\n"
 212             "Look up a network by name or net number in the network database.  The\n"
 213             "@var{net-name} argument must be a string, and the @var{net-number}\n"
 214             "argument must be an integer.  @code{getnet} will accept either type of\n"
 215             "argument, behaving like @code{getnetent} (see below) if no arguments are\n"
 216             "given.")
 217 #define FUNC_NAME s_scm_getnet
 218 {
 219   SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED);
 220   struct netent *entry;
 221   int eno;
 222
 223   if (SCM_UNBNDP (net))
 224     {
 225       entry = getnetent ();
 226       if (! entry)
 227         {
 228           /* There's no good way to tell whether zero means an error
 229              or end-of-file, so we always return #f.  See `gethost'
 230              for details. */
 231           return SCM_BOOL_F;
 232         }
 233     }
 234   else if (scm_is_string (net))
 235     {
 236       char *str = scm_to_locale_string (net);
 237       entry = getnetbyname (str);
 238       eno = errno;
 239       free (str);
 240     }
 241   else
 242     {
 243       unsigned long netnum = scm_to_ulong (net);
 244       entry = getnetbyaddr (netnum, AF_INET);
 245       eno = errno;
 246     }
 247
 248   if (!entry)
 249     SCM_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), eno);
 250
 251   SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->n_name));
 252   SCM_SIMPLE_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->n_aliases));
 253   SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_int (entry->n_addrtype));
 254   SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_ulong (entry->n_net));
 255   return result;
 256 }
 257 #undef FUNC_NAME
 258 #endif
 259
 260 #if defined (HAVE_GETPROTOENT)
 261 SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
 262             (SCM protocol),
 263             "@deffnx {Scheme Procedure} getprotobyname name\n"
 264             "@deffnx {Scheme Procedure} getprotobynumber number\n"
 265             "Look up a network protocol by name or by number.  @code{getprotobyname}\n"
 266             "takes a string argument, and @code{getprotobynumber} takes an integer\n"
 267             "argument.  @code{getproto} will accept either type, behaving like\n"
 268             "@code{getprotoent} (see below) if no arguments are supplied.")
 269 #define FUNC_NAME s_scm_getproto
 270 {
 271   SCM result = scm_c_make_vector (3, SCM_UNSPECIFIED);
 272   struct protoent *entry;
 273   int eno;
 274
 275   if (SCM_UNBNDP (protocol))
 276     {
 277       entry = getprotoent ();
 278       if (! entry)
 279         {
 280           /* There's no good way to tell whether zero means an error
 281              or end-of-file, so we always return #f.  See `gethost'
 282              for details. */
 283           return SCM_BOOL_F;
 284         }
 285     }
 286   else if (scm_is_string (protocol))
 287     {
 288       char *str = scm_to_locale_string (protocol);
 289       entry = getprotobyname (str);
 290       eno = errno;
 291       free (str);
 292     }
 293   else
 294     {
 295       unsigned long protonum = scm_to_ulong (protocol);
 296       entry = getprotobynumber (protonum);
 297       eno = errno;
 298     }
 299
 300   if (!entry)
 301     SCM_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), eno);
 302
 303   SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->p_name));
 304   SCM_SIMPLE_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->p_aliases));
 305   SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_int (entry->p_proto));
 306   return result;
 307 }
 308 #undef FUNC_NAME
 309 #endif
 310
 311 #if defined (HAVE_GETSERVENT)
 312 static SCM
 313 scm_return_entry (struct servent *entry)
 314 {
 315   SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED);
 316
 317   SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (entry->s_name));
 318   SCM_SIMPLE_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->s_aliases));
 319   SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_uint16 (ntohs (entry->s_port)));
 320   SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_locale_string (entry->s_proto));
 321   return result;
 322 }
 323
 324 SCM_DEFINE (scm_getserv, "getserv", 0, 2, 0,
 325             (SCM name, SCM protocol),
 326             "@deffnx {Scheme Procedure} getservbyname name protocol\n"
 327             "@deffnx {Scheme Procedure} getservbyport port protocol\n"
 328             "Look up a network service by name or by service number, and return a\n"
 329             "network service object.  The @var{protocol} argument specifies the name\n"
 330             "of the desired protocol; if the protocol found in the network service\n"
 331             "database does not match this name, a system error is signalled.\n\n"
 332             "The @code{getserv} procedure will take either a service name or number\n"
 333             "as its first argument; if given no arguments, it behaves like\n"
 334             "@code{getservent} (see below).")
 335 #define FUNC_NAME s_scm_getserv
 336 {
 337   struct servent *entry;
 338   char *protoname;
 339   int eno;
 340
 341   if (SCM_UNBNDP (name))
 342     {
 343       entry = getservent ();
 344       if (!entry)
 345         {
 346           /* There's no good way to tell whether zero means an error
 347              or end-of-file, so we always return #f.  See `gethost'
 348              for details. */
 349           return SCM_BOOL_F;
 350         }
 351       return scm_return_entry (entry);
 352     }
 353
 354   scm_dynwind_begin (0);
 355
 356   protoname = scm_to_locale_string (protocol);
 357   scm_dynwind_free (protoname);
 358
 359   if (scm_is_string (name))
 360     {
 361       char *str = scm_to_locale_string (name);
 362       entry = getservbyname (str, protoname);
 363       eno = errno;
 364       free (str);
 365     }
 366   else
 367     {
 368       entry = getservbyport (htons (scm_to_int (name)), protoname);
 369       eno = errno;
 370     }
 371
 372   if (!entry)
 373     SCM_SYSERROR_MSG("no such service ~A", scm_list_1 (name), eno);
 374
 375   scm_dynwind_end ();
 376   return scm_return_entry (entry);
 377 }
 378 #undef FUNC_NAME
 379 #endif
 380
 381 #if defined(HAVE_SETHOSTENT) && defined(HAVE_ENDHOSTENT)
 382 SCM_DEFINE (scm_sethost, "sethost", 0, 1, 0,
 383             (SCM stayopen),
 384             "If @var{stayopen} is omitted, this is equivalent to @code{endhostent}.\n"
 385             "Otherwise it is equivalent to @code{sethostent stayopen}.")
 386 #define FUNC_NAME s_scm_sethost
 387 {
 388   if (SCM_UNBNDP (stayopen))
 389     endhostent ();
 390   else
 391     sethostent (scm_is_true (stayopen));
 392   return SCM_UNSPECIFIED;
 393 }
 394 #undef FUNC_NAME
 395 #endif
 396
 397 #if defined(HAVE_SETNETENT) && defined(HAVE_ENDNETENT)
 398 SCM_DEFINE (scm_setnet, "setnet", 0, 1, 0,
 399             (SCM stayopen),
 400             "If @var{stayopen} is omitted, this is equivalent to @code{endnetent}.\n"
 401             "Otherwise it is equivalent to @code{setnetent stayopen}.")
 402 #define FUNC_NAME s_scm_setnet
 403 {
 404   if (SCM_UNBNDP (stayopen))
 405     endnetent ();
 406   else
 407     setnetent (scm_is_true (stayopen));
 408   return SCM_UNSPECIFIED;
 409 }
 410 #undef FUNC_NAME
 411 #endif
 412
 413 #if defined (HAVE_SETPROTOENT) && defined (HAVE_ENDPROTOENT)
 414 SCM_DEFINE (scm_setproto, "setproto", 0, 1, 0,
 415             (SCM stayopen),
 416             "If @var{stayopen} is omitted, this is equivalent to @code{endprotoent}.\n"
 417             "Otherwise it is equivalent to @code{setprotoent stayopen}.")
 418 #define FUNC_NAME s_scm_setproto
 419 {
 420   if (SCM_UNBNDP (stayopen))
 421     endprotoent ();
 422   else
 423     setprotoent (scm_is_true (stayopen));
 424   return SCM_UNSPECIFIED;
 425 }
 426 #undef FUNC_NAME
 427 #endif
 428
 429 #if defined (HAVE_SETSERVENT) && defined (HAVE_ENDSERVENT)
 430 SCM_DEFINE (scm_setserv, "setserv", 0, 1, 0,
 431             (SCM stayopen),
 432             "If @var{stayopen} is omitted, this is equivalent to @code{endservent}.\n"
 433             "Otherwise it is equivalent to @code{setservent stayopen}.")
 434 #define FUNC_NAME s_scm_setserv
 435 {
 436   if (SCM_UNBNDP (stayopen))
 437     endservent ();
 438   else
 439     setservent (scm_is_true (stayopen));
 440   return SCM_UNSPECIFIED;
 441 }
 442 #undef FUNC_NAME
 443 #endif
 444
 445 \f
 446 /* Protocol-independent name resolution with getaddrinfo(3) & co.  */
 447
 448 SCM_SYMBOL (sym_getaddrinfo_error, "getaddrinfo-error");
 449
 450 /* Make sure the `AI_*' flags can be stored as INUMs.  */
 451 verify (AI_ALL < SCM_MOST_POSITIVE_FIXNUM);
 452
 453 /* Valid values for the `ai_flags' to `struct addrinfo'.  */
 454 SCM_VARIABLE_INIT (sym_ai_passive, "AI_PASSIVE",
 455                    SCM_I_MAKINUM (AI_PASSIVE));
 456 SCM_VARIABLE_INIT (sym_ai_canonname, "AI_CANONNAME",
 457                    SCM_I_MAKINUM (AI_CANONNAME));
 458 SCM_VARIABLE_INIT (sym_ai_numerichost, "AI_NUMERICHOST",
 459                    SCM_I_MAKINUM (AI_NUMERICHOST));
 460 SCM_VARIABLE_INIT (sym_ai_numericserv, "AI_NUMERICSERV",
 461                    SCM_I_MAKINUM (AI_NUMERICSERV));
 462 SCM_VARIABLE_INIT (sym_ai_v4mapped, "AI_V4MAPPED",
 463                    SCM_I_MAKINUM (AI_V4MAPPED));
 464 SCM_VARIABLE_INIT (sym_ai_all, "AI_ALL",
 465                    SCM_I_MAKINUM (AI_ALL));
 466 SCM_VARIABLE_INIT (sym_ai_addrconfig, "AI_ADDRCONFIG",
 467                    SCM_I_MAKINUM (AI_ADDRCONFIG));
 468
 469 /* Return a Scheme vector whose elements correspond to the fields of C_AI,
 470    ignoring the `ai_next' field.  This function is not exported because the
 471    definition of `struct addrinfo' is provided by Gnulib.  */
 472 static SCM
 473 scm_from_addrinfo (const struct addrinfo *c_ai)
 474 {
 475   SCM ai;
 476
 477   /* Note: The indices here must be kept synchronized with those used by the
 478      `addrinfo:' procedures in `networking.scm'.  */
 479
 480   ai = scm_c_make_vector (6, SCM_UNDEFINED);
 481   SCM_SIMPLE_VECTOR_SET (ai, 0, scm_from_int (c_ai->ai_flags));
 482   SCM_SIMPLE_VECTOR_SET (ai, 1, scm_from_int (c_ai->ai_family));
 483   SCM_SIMPLE_VECTOR_SET (ai, 2, scm_from_int (c_ai->ai_socktype));
 484   SCM_SIMPLE_VECTOR_SET (ai, 3, scm_from_int (c_ai->ai_protocol));
 485   SCM_SIMPLE_VECTOR_SET (ai, 4,
 486                          scm_from_sockaddr (c_ai->ai_addr, c_ai->ai_addrlen));
 487   SCM_SIMPLE_VECTOR_SET (ai, 5,
 488                          c_ai->ai_canonname != NULL
 489                          ? scm_from_locale_string (c_ai->ai_canonname)
 490                          : SCM_BOOL_F);
 491
 492   return ai;
 493 }
 494
 495 SCM_DEFINE (scm_getaddrinfo, "getaddrinfo", 1, 5, 0,
 496             (SCM name, SCM service, SCM hint_flags, SCM hint_family,
 497              SCM hint_socktype, SCM hint_protocol),
 498             "Return a list of @code{addrinfo} structures containing "
 499             "a socket address and associated information for host @var{name} "
 500             "and/or @var{service} to be used in creating a socket with "
 501             "which to address the specified service.\n\n"
 502             "@example\n"
 503             "(let* ((ai (car (getaddrinfo \"www.gnu.org\" \"http\")))\n"
 504             "       (s  (socket (addrinfo:fam ai) (addrinfo:socktype ai)\n"
 505             "                   (addrinfo:protocol ai))))\n"
 506             "  (connect s (addrinfo:addr ai))\n"
 507             "  s)\n"
 508             "@end example\n\n"
 509             "When @var{service} is omitted or is @code{#f}, return "
 510             "network-level addresses for @var{name}.  When @var{name} "
 511             "is @code{#f} @var{service} must be provided and service "
 512             "locations local to the caller are returned.\n"
 513             "\n"
 514             "Additional hints can be provided.  When specified, "
 515             "@var{hint_flags} should be a bitwise-or of zero or more "
 516             "constants among the following:\n\n"
 517             "@table @code\n"
 518             "@item AI_PASSIVE\n"
 519             "Socket address is intended for @code{bind}.\n\n"
 520             "@item AI_CANONNAME\n"
 521             "Request for canonical host name, available via "
 522             "@code{addrinfo:canonname}.  This makes sense mainly when "
 523             "DNS lookups are involved.\n\n"
 524             "@item AI_NUMERICHOST\n"
 525             "Specifies that @var{name} is a numeric host address string "
 526             "(e.g., @code{\"127.0.0.1\"}), meaning that name resolution "
 527             "will not be used.\n\n"
 528             "@item AI_NUMERICSERV\n"
 529             "Likewise, specifies that @var{service} is a numeric port "
 530             "string (e.g., @code{\"80\"}).\n\n"
 531             "@item AI_ADDRCONFIG\n"
 532             "Return only addresses configured on the local system.  It is "
 533             "highly recommended to provide this flag when the returned "
 534             "socket addresses are to be used to make connections; "
 535             "otherwise, some of the returned addresses could be unreachable "
 536             "or use a protocol that is not supported.\n\n"
 537             "@item AI_V4MAPPED\n"
 538             "When looking up IPv6 addresses, return mapped "
 539             "IPv4 addresses if there is no IPv6 address available at all.\n\n"
 540             "@item AI_ALL\n"
 541             "If this flag is set along with @code{AI_V4MAPPED} when looking "
 542             "up IPv6 addresses, return all IPv6 addresses "
 543             "as well as all IPv4 addresses, the latter mapped to IPv6 "
 544             "format.\n"
 545             "@end table\n\n"
 546             "When given, @var{hint_family} should specify the requested "
 547             "address family, e.g., @code{AF_INET6}.  Similarly, "
 548             "@var{hint_socktype} should specify the requested socket type "
 549             "(e.g., @code{SOCK_DGRAM}), and @var{hint_protocol} should "
 550             "specify the requested protocol (its value is interpretered "
 551             "as in calls to @code{socket}).\n"
 552             "\n"
 553             "On error, an exception with key @code{getaddrinfo-error} is "
 554             "thrown, with an error code (an integer) as its argument:\n\n"
 555             "@example\n"
 556             "(catch 'getaddrinfo-error\n"
 557             "  (lambda ()\n"
 558             "    (getaddrinfo \"www.gnu.org\" \"gopher\"))\n"
 559             "  (lambda (key errcode)\n"
 560             "    (cond ((= errcode EAI_SERVICE)\n"
 561             "           (display \"doesn't know about Gopher!\\n\"))\n"
 562             "          ((= errcode EAI_NONAME)\n"
 563             "           (display \"www.gnu.org not found\\n\"))\n"
 564             "          (else\n"
 565             "           (format #t \"something wrong: ~a\\n\"\n"
 566             "                   (gai-strerror errcode))))))\n"
 567             "@end example\n"
 568             "\n"
 569             "Error codes are:\n\n"
 570             "@table @code\n"
 571             "@item EAI_AGAIN\n"
 572             "The name or service could not be resolved at this time. Future "
 573             "attempts may succeed.\n\n"
 574             "@item EAI_BADFLAGS\n"
 575             "@var{hint_flags} contains an invalid value.\n\n"
 576             "@item EAI_FAIL\n"
 577             "A non-recoverable error occurred when attempting to "
 578             "resolve the name.\n\n"
 579             "@item EAI_FAMILY\n"
 580             "@var{hint_family} was not recognized.\n\n"
 581             "@item EAI_NONAME\n"
 582             "Either @var{name} does not resolve for the supplied parameters, "
 583             "or neither @var{name} nor @var{service} were supplied.\n\n"
 584
 585             /* See `sysdeps/posix/getaddrinfo.c' in the GNU libc, and
 586                <http://www.opensource.apple.com/source/Libinfo/Libinfo-324.1/lookup.subproj/netdb.h>,
 587                for details on EAI_NODATA.  */
 588             "@item EAI_NODATA\n"
 589             "This non-POSIX error code can be returned on some systems (GNU "
 590             "and Darwin, at least), for example when @var{name} is known "
 591             "but requests that were made turned out no data.  Error handling\n"
 592             "code should be prepared to handle it when it is defined.\n\n"
 593             "@item EAI_SERVICE\n"
 594             "@var{service} was not recognized for the specified socket type.\n\n"
 595             "@item EAI_SOCKTYPE\n"
 596             "@var{hint_socktype} was not recognized.\n\n"
 597             "@item EAI_SYSTEM\n"
 598             "A system error occurred.  In C, the error code can be found in "
 599             "@code{errno}; this value is not accessible from Scheme, but in\n"
 600             "practice it provides little information about the actual error "
 601             "cause.\n\n"          /* see <http://bugs.gnu.org/13958>. */
 602             "@end table\n"
 603             "\n"
 604             "Users are encouraged to read the "
 605             "@url{http://www.opengroup.org/onlinepubs/9699919799/functions/getaddrinfo.html,"
 606             "POSIX specification} for more details.\n")
 607 #define FUNC_NAME s_scm_getaddrinfo
 608 {
 609   int err;
 610   char *c_name, *c_service;
 611   struct addrinfo c_hints, *c_result;
 612   SCM result = SCM_EOL;
 613
 614   if (scm_is_true (name))
 615     SCM_VALIDATE_STRING (SCM_ARG1, name);
 616
 617   if (!SCM_UNBNDP (service) && scm_is_true (service))
 618     SCM_VALIDATE_STRING (SCM_ARG2, service);
 619
 620   scm_dynwind_begin (0);
 621
 622   if (scm_is_string (name))
 623     {
 624       c_name = scm_to_locale_string (name);
 625       scm_dynwind_free (c_name);
 626     }
 627   else
 628     c_name = NULL;
 629
 630   if (scm_is_string (service))
 631     {
 632       c_service = scm_to_locale_string (service);
 633       scm_dynwind_free (c_service);
 634     }
 635   else
 636     c_service = NULL;
 637
 638   memset (&c_hints, 0, sizeof (c_hints));
 639   if (!SCM_UNBNDP (hint_flags))
 640     {
 641       c_hints.ai_flags = scm_to_int (hint_flags);
 642       if (!SCM_UNBNDP (hint_family))
 643         {
 644           c_hints.ai_family = scm_to_int (hint_family);
 645           if (!SCM_UNBNDP (hint_socktype))
 646             {
 647               c_hints.ai_socktype = scm_to_int (hint_socktype);
 648               if (!SCM_UNBNDP (hint_family))
 649                 c_hints.ai_family = scm_to_int (hint_family);
 650             }
 651         }
 652     }
 653
 654   err = getaddrinfo (c_name, c_service, &c_hints, &c_result);
 655   if (err == 0)
 656     {
 657       SCM *prev_addr;
 658       struct addrinfo *a;
 659
 660       for (prev_addr = &result, a = c_result;
 661            a != NULL;
 662            a = a->ai_next, prev_addr = SCM_CDRLOC (*prev_addr))
 663         *prev_addr = scm_list_1 (scm_from_addrinfo (a));
 664
 665       freeaddrinfo (c_result);
 666     }
 667   else
 668     scm_throw (sym_getaddrinfo_error, scm_list_1 (scm_from_int (err)));
 669
 670   scm_dynwind_end ();
 671
 672   return result;
 673 }
 674 #undef FUNC_NAME
 675
 676 /* Make sure the `EAI_*' flags can be stored as INUMs.  */
 677 verify (EAI_BADFLAGS < SCM_MOST_POSITIVE_FIXNUM);
 678
 679 /* Error codes returned by `getaddrinfo'.  */
 680 SCM_VARIABLE_INIT (sym_eai_badflags, "EAI_BADFLAGS",
 681                    SCM_I_MAKINUM (EAI_BADFLAGS));
 682 SCM_VARIABLE_INIT (sym_eai_noname, "EAI_NONAME",
 683                    SCM_I_MAKINUM (EAI_NONAME));
 684 SCM_VARIABLE_INIT (sym_eai_again, "EAI_AGAIN",
 685                    SCM_I_MAKINUM (EAI_AGAIN));
 686 SCM_VARIABLE_INIT (sym_eai_fail, "EAI_FAIL",
 687                    SCM_I_MAKINUM (EAI_FAIL));
 688 SCM_VARIABLE_INIT (sym_eai_family, "EAI_FAMILY",
 689                    SCM_I_MAKINUM (EAI_FAMILY));
 690 SCM_VARIABLE_INIT (sym_eai_socktype, "EAI_SOCKTYPE",
 691                    SCM_I_MAKINUM (EAI_SOCKTYPE));
 692 SCM_VARIABLE_INIT (sym_eai_service, "EAI_SERVICE",
 693                    SCM_I_MAKINUM (EAI_SERVICE));
 694 SCM_VARIABLE_INIT (sym_eai_memory, "EAI_MEMORY",
 695                    SCM_I_MAKINUM (EAI_MEMORY));
 696 SCM_VARIABLE_INIT (sym_eai_system, "EAI_SYSTEM",
 697                    SCM_I_MAKINUM (EAI_SYSTEM));
 698 SCM_VARIABLE_INIT (sym_eai_overflow, "EAI_OVERFLOW",
 699                    SCM_I_MAKINUM (EAI_OVERFLOW));
 700
 701 /* The following values are GNU extensions.  */
 702 #ifdef EAI_NODATA
 703 SCM_VARIABLE_INIT (sym_eai_nodata, "EAI_NODATA",
 704                    SCM_I_MAKINUM (EAI_NODATA));
 705 #endif
 706 #ifdef EAI_ADDRFAMILY
 707 SCM_VARIABLE_INIT (sym_eai_addrfamily, "EAI_ADDRFAMILY",
 708                    SCM_I_MAKINUM (EAI_ADDRFAMILY));
 709 #endif
 710 #ifdef EAI_INPROGRESS
 711 SCM_VARIABLE_INIT (sym_eai_inprogress, "EAI_INPROGRESS",
 712                    SCM_I_MAKINUM (EAI_INPROGRESS));
 713 #endif
 714 #ifdef EAI_CANCELED
 715 SCM_VARIABLE_INIT (sym_eai_canceled, "EAI_CANCELED",
 716                    SCM_I_MAKINUM (EAI_CANCELED));
 717 #endif
 718 #ifdef EAI_NOTCANCELED
 719 SCM_VARIABLE_INIT (sym_eai_notcanceled, "EAI_NOTCANCELED",
 720                    SCM_I_MAKINUM (EAI_NOTCANCELED));
 721 #endif
 722 #ifdef EAI_ALLDONE
 723 SCM_VARIABLE_INIT (sym_eai_alldone, "EAI_ALLDONE",
 724                    SCM_I_MAKINUM (EAI_ALLDONE));
 725 #endif
 726 #ifdef EAI_INTR
 727 SCM_VARIABLE_INIT (sym_eai_intr, "EAI_INTR",
 728                    SCM_I_MAKINUM (EAI_INTR));
 729 #endif
 730 #ifdef EAI_IDN_ENCODE
 731 SCM_VARIABLE_INIT (sym_eai_idn_encode, "EAI_IDN_ENCODE",
 732                    SCM_I_MAKINUM (EAI_IDN_ENCODE));
 733 #endif
 734
 735 SCM_DEFINE (scm_gai_strerror, "gai-strerror", 1, 0, 0,
 736             (SCM error),
 737             "Return a string describing @var{error}, an integer error code "
 738             "returned by @code{getaddrinfo}.")
 739 #define FUNC_NAME s_scm_gai_strerror
 740 {
 741   return scm_from_locale_string (gai_strerror (scm_to_int (error)));
 742 }
 743 #undef FUNC_NAME
 744
 745 /* TODO: Add a getnameinfo(3) wrapper.  */
 746
 747 \f
 748 void
 749 scm_init_net_db ()
 750 {
 751   scm_add_feature ("net-db");
 752 #include "libguile/net_db.x"
 753 }
 754
 755 /*
 756   Local Variables:
 757   c-file-style: "gnu"
 758   End:
 759 */