libguile/net_db.c

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