libguile/net_db.c

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