guile18/libguile/win32-socket.c

   1 /* Copyright (C) 2001, 2006 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public
   5  * License as published by the Free Software Foundation; either
   6  * version 2.1 of the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  16  */
  17
  18
  19 \f
  20
  21 #ifdef HAVE_CONFIG_H
  22 #  include <config.h>
  23 #endif
  24
  25 #include "libguile/__scm.h"
  26 #include "libguile/modules.h"
  27 #include "libguile/numbers.h"
  28
  29 #include <stdio.h>
  30 #include <stdlib.h>
  31 #include <string.h>
  32 #include <ctype.h>
  33 #include <errno.h>
  34 #include <limits.h>
  35
  36 #ifndef PATH_MAX
  37 #define PATH_MAX 255
  38 #endif
  39
  40 #include "win32-socket.h"
  41
  42 /* Winsock API error description structure.  The error description is
  43    necessary because there is no error list available.  */
  44 typedef struct
  45 {
  46   int error;         /* Error code.  */
  47   char *str;         /* Error description.  */
  48   int replace;       /* Possible error code replacement.  */
  49   char *replace_str; /* Replacement symbol.  */
  50   char *correct_str; /* Original symbol.  */
  51 }
  52 socket_error_t;
  53
  54 #define FILE_ETC_SERVICES     "services"
  55 #define ENVIRON_ETC_SERVICES  "SERVICES"
  56 #define FILE_ETC_NETWORKS     "networks"
  57 #define ENVIRON_ETC_NETWORKS  "NETWORKS"
  58 #define FILE_ETC_PROTOCOLS    "protocol"
  59 #define ENVIRON_ETC_PROTOCOLS "PROTOCOLS"
  60 #define MAX_NAMLEN  256
  61 #define MAX_ALIASES 4
  62
  63 /* Internal structure for a thread's M$-Windows servent interface.  */
  64 typedef struct
  65 {
  66   FILE *fd;                            /* Current file.  */
  67   char file[PATH_MAX];                 /* File name.  */
  68   struct servent ent;                  /* Return value.  */
  69   char name[MAX_NAMLEN];               /* Service name.  */
  70   char proto[MAX_NAMLEN];              /* Protocol name.  */
  71   char alias[MAX_ALIASES][MAX_NAMLEN]; /* All aliases.  */
  72   char *aliases[MAX_ALIASES];          /* Alias pointers.  */
  73   int port;                            /* Network port.  */
  74 }
  75 scm_i_servent_t;
  76
  77 static scm_i_servent_t scm_i_servent;
  78
  79 /* Internal structure for a thread's M$-Windows protoent interface.  */
  80 typedef struct
  81 {
  82   FILE *fd;                            /* Current file.  */
  83   char file[PATH_MAX];                 /* File name.  */
  84   struct protoent ent;                 /* Return value.  */
  85   char name[MAX_NAMLEN];               /* Protocol name.  */
  86   char alias[MAX_ALIASES][MAX_NAMLEN]; /* All aliases.  */
  87   char *aliases[MAX_ALIASES];          /* Alias pointers.  */
  88   int proto;                           /* Protocol number.  */
  89 }
  90 scm_i_protoent_t;
  91
  92 static scm_i_protoent_t scm_i_protoent;
  93
  94 /* Define replacement symbols for most of the WSA* error codes.  */
  95 #ifndef EWOULDBLOCK
  96 # define EWOULDBLOCK     WSAEWOULDBLOCK
  97 #endif
  98 #ifndef EINPROGRESS
  99 # define EINPROGRESS     WSAEINPROGRESS
 100 #endif
 101 #ifndef EALREADY
 102 # define EALREADY        WSAEALREADY
 103 #endif
 104 #ifndef EDESTADDRREQ
 105 # define EDESTADDRREQ    WSAEDESTADDRREQ
 106 #endif
 107 #ifndef EMSGSIZE
 108 # define EMSGSIZE        WSAEMSGSIZE
 109 #endif
 110 #ifndef EPROTOTYPE
 111 # define EPROTOTYPE      WSAEPROTOTYPE
 112 #endif
 113 #ifndef ENOTSOCK
 114 # define ENOTSOCK        WSAENOTSOCK
 115 #endif
 116 #ifndef ENOPROTOOPT
 117 # define ENOPROTOOPT     WSAENOPROTOOPT
 118 #endif
 119 #ifndef EPROTONOSUPPORT
 120 # define EPROTONOSUPPORT WSAEPROTONOSUPPORT
 121 #endif
 122 #ifndef ESOCKTNOSUPPORT
 123 # define ESOCKTNOSUPPORT WSAESOCKTNOSUPPORT
 124 #endif
 125 #ifndef EOPNOTSUPP
 126 # define EOPNOTSUPP      WSAEOPNOTSUPP
 127 #endif
 128 #ifndef EPFNOSUPPORT
 129 # define EPFNOSUPPORT    WSAEPFNOSUPPORT
 130 #endif
 131 #ifndef EAFNOSUPPORT
 132 # define EAFNOSUPPORT    WSAEAFNOSUPPORT
 133 #endif
 134 #ifndef EADDRINUSE
 135 # define EADDRINUSE      WSAEADDRINUSE
 136 #endif
 137 #ifndef EADDRNOTAVAIL
 138 # define EADDRNOTAVAIL   WSAEADDRNOTAVAIL
 139 #endif
 140 #ifndef ENETDOWN
 141 # define ENETDOWN        WSAENETDOWN
 142 #endif
 143 #ifndef ENETUNREACH
 144 # define ENETUNREACH     WSAENETUNREACH
 145 #endif
 146 #ifndef ENETRESET
 147 # define ENETRESET       WSAENETRESET
 148 #endif
 149 #ifndef ECONNABORTED
 150 # define ECONNABORTED    WSAECONNABORTED
 151 #endif
 152 #ifndef ECONNRESET
 153 # define ECONNRESET      WSAECONNRESET
 154 #endif
 155 #ifndef ENOBUFS
 156 # define ENOBUFS         WSAENOBUFS
 157 #endif
 158 #ifndef EISCONN
 159 # define EISCONN         WSAEISCONN
 160 #endif
 161 #ifndef ENOTCONN
 162 # define ENOTCONN        WSAENOTCONN
 163 #endif
 164 #ifndef ESHUTDOWN
 165 # define ESHUTDOWN       WSAESHUTDOWN
 166 #endif
 167 #ifndef ETOOMANYREFS
 168 # define ETOOMANYREFS    WSAETOOMANYREFS
 169 #endif
 170 #ifndef ETIMEDOUT
 171 # define ETIMEDOUT       WSAETIMEDOUT
 172 #endif
 173 #ifndef ECONNREFUSED
 174 # define ECONNREFUSED    WSAECONNREFUSED
 175 #endif
 176 #ifndef ELOOP
 177 # define ELOOP           WSAELOOP
 178 #endif
 179 #ifndef EHOSTDOWN
 180 # define EHOSTDOWN       WSAEHOSTDOWN
 181 #endif
 182 #ifndef EHOSTUNREACH
 183 # define EHOSTUNREACH    WSAEHOSTUNREACH
 184 #endif
 185 #ifndef EPROCLIM
 186 # define EPROCLIM        WSAEPROCLIM
 187 #endif
 188 #ifndef EUSERS
 189 # define EUSERS          WSAEUSERS
 190 #endif
 191 #ifndef EDQUOT
 192 # define EDQUOT          WSAEDQUOT
 193 #endif
 194 #ifndef ESTALE
 195 # define ESTALE          WSAESTALE
 196 #endif
 197 #ifndef EREMOTE
 198 # define EREMOTE         WSAEREMOTE
 199 #endif
 200
 201 /* List of error structures.  */
 202 static socket_error_t socket_errno [] = {
 203   /* 000 */ { 0, NULL, 0, NULL, NULL },
 204   /* 001 */ { 0, NULL, 0, NULL, NULL },
 205   /* 002 */ { 0, NULL, 0, NULL, NULL },
 206   /* 003 */ { 0, NULL, 0, NULL, NULL },
 207   /* 004 */ { WSAEINTR, "Interrupted function call", EINTR, NULL, "WSAEINTR" },
 208   /* 005 */ { 0, NULL, 0, NULL, NULL },
 209   /* 006 */ { 0, NULL, 0, NULL, NULL },
 210   /* 007 */ { 0, NULL, 0, NULL, NULL },
 211   /* 008 */ { 0, NULL, 0, NULL, NULL },
 212   /* 009 */ { WSAEBADF, "Bad file number", EBADF, NULL, "WSAEBADF" },
 213   /* 010 */ { 0, NULL, 0, NULL, NULL },
 214   /* 011 */ { 0, NULL, 0, NULL, NULL },
 215   /* 012 */ { 0, NULL, 0, NULL, NULL },
 216   /* 013 */ { WSAEACCES, "Permission denied", EACCES, NULL, "WSAEACCES" },
 217   /* 014 */ { WSAEFAULT, "Bad address", EFAULT, NULL, "WSAEFAULT" },
 218   /* 015 */ { 0, NULL, 0, NULL, NULL },
 219   /* 016 */ { 0, NULL, 0, NULL, NULL },
 220   /* 017 */ { 0, NULL, 0, NULL, NULL },
 221   /* 018 */ { 0, NULL, 0, NULL, NULL },
 222   /* 019 */ { 0, NULL, 0, NULL, NULL },
 223   /* 020 */ { 0, NULL, 0, NULL, NULL },
 224   /* 021 */ { 0, NULL, 0, NULL, NULL },
 225   /* 022 */ { WSAEINVAL, "Invalid argument", EINVAL, NULL, "WSAEINVAL" },
 226   /* 023 */ { 0, NULL, 0, NULL, NULL },
 227   /* 024 */ { WSAEMFILE, "Too many open files", EMFILE, NULL, "WSAEMFILE" },
 228   /* 025 */ { 0, NULL, 0, NULL, NULL },
 229   /* 026 */ { 0, NULL, 0, NULL, NULL },
 230   /* 027 */ { 0, NULL, 0, NULL, NULL },
 231   /* 028 */ { 0, NULL, 0, NULL, NULL },
 232   /* 029 */ { 0, NULL, 0, NULL, NULL },
 233   /* 030 */ { 0, NULL, 0, NULL, NULL },
 234   /* 031 */ { 0, NULL, 0, NULL, NULL },
 235   /* 032 */ { 0, NULL, 0, NULL, NULL },
 236   /* 033 */ { 0, NULL, 0, NULL, NULL },
 237   /* 034 */ { 0, NULL, 0, NULL, NULL },
 238   /* 035 */ { WSAEWOULDBLOCK, "Resource temporarily unavailable",
 239               EWOULDBLOCK, "EWOULDBLOCK", "WSAEWOULDBLOCK" },
 240   /* 036 */ { WSAEINPROGRESS, "Operation now in progress",
 241               EINPROGRESS, "EINPROGRESS", "WSAEINPROGRESS" },
 242   /* 037 */ { WSAEALREADY, "Operation already in progress",
 243               EALREADY, "EALREADY", "WSAEALREADY" },
 244   /* 038 */ { WSAENOTSOCK, "Socket operation on non-socket",
 245               ENOTSOCK, "ENOTSOCK", "WSAENOTSOCK"},
 246   /* 039 */ { WSAEDESTADDRREQ, "Destination address required",
 247               EDESTADDRREQ, "EDESTADDRREQ", "WSAEDESTADDRREQ" },
 248   /* 040 */ { WSAEMSGSIZE, "Message too long",
 249               EMSGSIZE, "EMSGSIZE", "WSAEMSGSIZE" },
 250   /* 041 */ { WSAEPROTOTYPE, "Protocol wrong type for socket",
 251               EPROTOTYPE, "EPROTOTYPE", "WSAEPROTOTYPE" },
 252   /* 042 */ { WSAENOPROTOOPT, "Bad protocol option",
 253               ENOPROTOOPT, "ENOPROTOOPT", "WSAENOPROTOOPT" },
 254   /* 043 */ { WSAEPROTONOSUPPORT, "Protocol not supported",
 255               EPROTONOSUPPORT, "EPROTONOSUPPORT", "WSAEPROTONOSUPPORT" },
 256   /* 044 */ { WSAESOCKTNOSUPPORT, "Socket type not supported",
 257               ESOCKTNOSUPPORT, "ESOCKTNOSUPPORT", "WSAESOCKTNOSUPPORT" },
 258   /* 045 */ { WSAEOPNOTSUPP, "Operation not supported",
 259               EOPNOTSUPP, "EOPNOTSUPP", "WSAEOPNOTSUPP" },
 260   /* 046 */ { WSAEPFNOSUPPORT, "Protocol family not supported",
 261               EPFNOSUPPORT, "EPFNOSUPPORT", "WSAEPFNOSUPPORT" },
 262   /* 047 */ { WSAEAFNOSUPPORT,
 263               "Address family not supported by protocol family",
 264               EAFNOSUPPORT, "EAFNOSUPPORT", "WSAEAFNOSUPPORT" },
 265   /* 048 */ { WSAEADDRINUSE, "Address already in use",
 266               EADDRINUSE, "EADDRINUSE", "WSAEADDRINUSE" },
 267   /* 049 */ { WSAEADDRNOTAVAIL, "Cannot assign requested address",
 268               EADDRNOTAVAIL, "EADDRNOTAVAIL", "WSAEADDRNOTAVAIL" },
 269   /* 050 */ { WSAENETDOWN, "Network is down",
 270               ENETDOWN, "ENETDOWN", "WSAENETDOWN" },
 271   /* 051 */ { WSAENETUNREACH, "Network is unreachable",
 272               ENETUNREACH, "ENETUNREACH", "WSAENETUNREACH" },
 273   /* 052 */ { WSAENETRESET, "Network dropped connection on reset",
 274               ENETRESET, "ENETRESET", "WSAENETRESET" },
 275   /* 053 */ { WSAECONNABORTED, "Software caused connection abort",
 276               ECONNABORTED, "ECONNABORTED", "WSAECONNABORTED" },
 277   /* 054 */ { WSAECONNRESET, "Connection reset by peer",
 278               ECONNRESET, "ECONNRESET", "WSAECONNRESET" },
 279   /* 055 */ { WSAENOBUFS, "No buffer space available",
 280               ENOBUFS, "ENOBUFS", "WSAENOBUFS" },
 281   /* 056 */ { WSAEISCONN, "Socket is already connected",
 282               EISCONN, "EISCONN", "WSAEISCONN" },
 283   /* 057 */ { WSAENOTCONN, "Socket is not connected",
 284               ENOTCONN, "ENOTCONN", "WSAENOTCONN" },
 285   /* 058 */ { WSAESHUTDOWN, "Cannot send after socket shutdown",
 286               ESHUTDOWN, "ESHUTDOWN", "WSAESHUTDOWN" },
 287   /* 059 */ { WSAETOOMANYREFS, "Too many references; can't splice",
 288               ETOOMANYREFS, "ETOOMANYREFS", "WSAETOOMANYREFS" },
 289   /* 060 */ { WSAETIMEDOUT, "Connection timed out",
 290               ETIMEDOUT, "ETIMEDOUT", "WSAETIMEDOUT" },
 291   /* 061 */ { WSAECONNREFUSED, "Connection refused",
 292               ECONNREFUSED, "ECONNREFUSED", "WSAECONNREFUSED" },
 293   /* 062 */ { WSAELOOP, "Too many levels of symbolic links",
 294               ELOOP, "ELOOP", "WSAELOOP" },
 295   /* 063 */ { WSAENAMETOOLONG, "File name too long",
 296               ENAMETOOLONG, NULL, "WSAENAMETOOLONG" },
 297   /* 064 */ { WSAEHOSTDOWN, "Host is down",
 298               EHOSTDOWN, "EHOSTDOWN", "WSAEHOSTDOWN" },
 299   /* 065 */ { WSAEHOSTUNREACH, "No route to host",
 300               EHOSTUNREACH, "EHOSTUNREACH", "WSAEHOSTUNREACH" },
 301   /* 066 */ { WSAENOTEMPTY, "Directory not empty",
 302               ENOTEMPTY, NULL, "WSAENOTEMPTY" },
 303   /* 067 */ { WSAEPROCLIM, "Too many processes",
 304               EPROCLIM, "EPROCLIM", "WSAEPROCLIM" },
 305   /* 068 */ { WSAEUSERS, "Too many users",
 306               EUSERS, "EUSERS", "WSAEUSERS" },
 307   /* 069 */ { WSAEDQUOT, "Disc quota exceeded",
 308               EDQUOT, "EDQUOT", "WSAEDQUOT" },
 309   /* 070 */ { WSAESTALE, "Stale NFS file handle",
 310               ESTALE, "ESTALE", "WSAESTALE" },
 311   /* 071 */ { WSAEREMOTE, "Too many levels of remote in path",
 312               EREMOTE, "EREMOTE", "WSAEREMOTE" },
 313   /* 072 */ { 0, NULL, 0, NULL, NULL },
 314   /* 073 */ { 0, NULL, 0, NULL, NULL },
 315   /* 074 */ { 0, NULL, 0, NULL, NULL },
 316   /* 075 */ { 0, NULL, 0, NULL, NULL },
 317   /* 076 */ { 0, NULL, 0, NULL, NULL },
 318   /* 077 */ { 0, NULL, 0, NULL, NULL },
 319   /* 078 */ { 0, NULL, 0, NULL, NULL },
 320   /* 079 */ { 0, NULL, 0, NULL, NULL },
 321   /* 080 */ { 0, NULL, 0, NULL, NULL },
 322   /* 081 */ { 0, NULL, 0, NULL, NULL },
 323   /* 082 */ { 0, NULL, 0, NULL, NULL },
 324   /* 083 */ { 0, NULL, 0, NULL, NULL },
 325   /* 084 */ { 0, NULL, 0, NULL, NULL },
 326   /* 085 */ { 0, NULL, 0, NULL, NULL },
 327   /* 086 */ { 0, NULL, 0, NULL, NULL },
 328   /* 087 */ { 0, NULL, 0, NULL, NULL },
 329   /* 088 */ { 0, NULL, 0, NULL, NULL },
 330   /* 089 */ { 0, NULL, 0, NULL, NULL },
 331   /* 090 */ { 0, NULL, 0, NULL, NULL },
 332   /* 091 */ { WSASYSNOTREADY, "Network subsystem is unavailable",
 333               0, NULL, "WSASYSNOTREADY" },
 334   /* 092 */ { WSAVERNOTSUPPORTED, "WINSOCK.DLL version out of range",
 335               0, NULL, "WSAVERNOTSUPPORTED" },
 336   /* 093 */ { WSANOTINITIALISED, "Successful WSAStartup not yet performed",
 337               0, NULL, "WSANOTINITIALISED" },
 338   /* 094 */ { 0, NULL, 0, NULL, NULL },
 339   /* 095 */ { 0, NULL, 0, NULL, NULL },
 340   /* 096 */ { 0, NULL, 0, NULL, NULL },
 341   /* 097 */ { 0, NULL, 0, NULL, NULL },
 342   /* 098 */ { 0, NULL, 0, NULL, NULL },
 343   /* 099 */ { 0, NULL, 0, NULL, NULL },
 344   /* 100 */ { 0, NULL, 0, NULL, NULL },
 345   /* 101 */ { WSAEDISCON, "Graceful shutdown in progress",
 346               0, NULL, "WSAEDISCON" },
 347   /* 102 */ { WSAENOMORE, "No more services",
 348               0, NULL, "WSAENOMORE" },
 349   /* 103 */ { WSAECANCELLED, "Service lookup cancelled",
 350               0, NULL, "WSAECANCELLED" },
 351   /* 104 */ { WSAEINVALIDPROCTABLE, "Invalid procedure call table",
 352               0, NULL, "WSAEINVALIDPROCTABLE" },
 353   /* 105 */ { WSAEINVALIDPROVIDER, "Invalid service provider",
 354               0, NULL, "WSAEINVALIDPROVIDER" },
 355   /* 106 */ { WSAEPROVIDERFAILEDINIT, "Service provider failure",
 356               0, NULL, "WSAEPROVIDERFAILEDINIT" },
 357   /* 107 */ { WSASYSCALLFAILURE, "System call failed",
 358               0, NULL, "WSASYSCALLFAILURE" },
 359   /* 108 */ { WSASERVICE_NOT_FOUND, "No such service",
 360               0, NULL, "WSASERVICE_NOT_FOUND" },
 361   /* 109 */ { WSATYPE_NOT_FOUND, "Class not found",
 362               0, NULL, "WSATYPE_NOT_FOUND" },
 363   /* 110 */ { WSA_E_NO_MORE, "No more services",
 364               0, NULL, "WSA_E_NO_MORE" },
 365   /* 111 */ { WSA_E_CANCELLED, "Service lookup cancelled",
 366               0, NULL, "WSA_E_CANCELLED" },
 367   /* 112 */ { WSAEREFUSED, "Database query refused",
 368               0, NULL, "WSAEREFUSED" },
 369   /* end */ { -1, NULL, -1, NULL, NULL }
 370 };
 371
 372 /* Extended list of error structures.  */
 373 static socket_error_t socket_h_errno [] = {
 374   /* 000 */ { 0, NULL, 0, NULL, NULL },
 375   /* 001 */ { WSAHOST_NOT_FOUND, "Host not found",
 376               HOST_NOT_FOUND, "HOST_NOT_FOUND", "WSAHOST_NOT_FOUND" },
 377   /* 002 */ { WSATRY_AGAIN, "Non-authoritative host not found",
 378               TRY_AGAIN, "TRY_AGAIN", "WSATRY_AGAIN" },
 379   /* 003 */ { WSANO_RECOVERY, "This is a non-recoverable error",
 380               NO_RECOVERY, "NO_RECOVERY", "WSANO_RECOVERY" },
 381   /* 004 */ { WSANO_DATA, "Valid name, no data record of requested type",
 382               NO_DATA, "NO_DATA", "WSANO_DATA" },
 383   /* 005 */ { WSANO_ADDRESS, "No address, look for MX record",
 384               NO_ADDRESS, "NO_ADDRESS", "WSANO_ADDRESS" },
 385   /* end */ { -1, NULL, -1, NULL, NULL }
 386 };
 387
 388 /* Returns the result of @code{WSAGetLastError()}.  */
 389 int
 390 scm_i_socket_errno (void)
 391 {
 392   return WSAGetLastError ();
 393 }
 394
 395 /* Returns a valid error message for Winsock-API error codes obtained via
 396    @code{WSAGetLastError()} or NULL otherwise.  */
 397 char *
 398 scm_i_socket_strerror (int error)
 399 {
 400   if (error >= WSABASEERR && error <= (WSABASEERR + 112))
 401     return socket_errno[error - WSABASEERR].str;
 402   else if (error >= (WSABASEERR + 1000) && error <= (WSABASEERR + 1005))
 403     return socket_h_errno[error - (WSABASEERR + 1000)].str;
 404   return NULL;
 405 }
 406
 407 /* Constructs a valid filename for the given file @var{file} in the M$-Windows
 408    directory.  This is usually the default location for the network files.  */
 409 char *
 410 scm_i_socket_filename (char *file)
 411 {
 412   static char dir[PATH_MAX];
 413   int len = PATH_MAX;
 414
 415   len = GetWindowsDirectory (dir, len);
 416   if (dir[len - 1] != '\\')
 417     strcat (dir, "\\");
 418   strcat (dir, file);
 419   return dir;
 420 }
 421
 422 /* Removes comments and white spaces at end of line and returns a pointer
 423    to the end of the line.  */
 424 static char *
 425 scm_i_socket_uncomment (char *line)
 426 {
 427   char *end;
 428
 429   if ((end = strchr (line, '#')) != NULL)
 430     *end-- = '\0';
 431   else
 432     {
 433       end = line + strlen (line) - 1;
 434       while (end > line && (*end == '\r' || *end == '\n'))
 435         *end-- = '\0';
 436     }
 437   while (end > line && isspace (*end))
 438     *end-- = '\0';
 439
 440   return end;
 441 }
 442
 443 /* The getservent() function reads the next line from the file `/etc/services'
 444    and returns a structure servent containing the broken out fields from the
 445    line.  The `/etc/services' file is opened if necessary. */
 446 struct servent *
 447 getservent (void)
 448 {
 449   char line[MAX_NAMLEN], *end, *p;
 450   int done = 0, i, n, a;
 451   struct servent *e = NULL;
 452
 453   /* Ensure a open file.  */
 454   if (scm_i_servent.fd == NULL || feof (scm_i_servent.fd))
 455     {
 456       setservent (1);
 457       if (scm_i_servent.fd == NULL)
 458         return NULL;
 459     }
 460
 461   while (!done)
 462     {
 463       /* Get new line.  */
 464       if (fgets (line, MAX_NAMLEN, scm_i_servent.fd) != NULL)
 465         {
 466           end = scm_i_socket_uncomment (line);
 467
 468           /* Scan the line.  */
 469           if ((i = sscanf (line, "%s %d/%s%n",
 470                            scm_i_servent.name,
 471                            &scm_i_servent.port,
 472                            scm_i_servent.proto, &n)) != 3)
 473             continue;
 474
 475           /* Scan the remaining aliases.  */
 476           p = line + n;
 477           for (a = 0; a < MAX_ALIASES && p < end && i != -1 && n > 1;
 478                a++, p += n)
 479             i = sscanf (p, "%s%n", scm_i_servent.alias[a], &n);
 480
 481           /* Prepare the return value.  */
 482           e = &scm_i_servent.ent;
 483           e->s_name = scm_i_servent.name;
 484           e->s_port = htons (scm_i_servent.port);
 485           e->s_proto = scm_i_servent.proto;
 486           e->s_aliases = scm_i_servent.aliases;
 487           scm_i_servent.aliases[a] = NULL;
 488           while (a--)
 489             scm_i_servent.aliases[a] = scm_i_servent.alias[a];
 490           done = 1;
 491         }
 492       else
 493         break;
 494     }
 495   return done ? e : NULL;
 496 }
 497
 498 /* The setservent() function opens and rewinds the `/etc/services' file.
 499    This file can be set from outside with an environment variable specifying
 500    the file name.  */
 501 void
 502 setservent (int stayopen)
 503 {
 504   char *file = NULL;
 505
 506   endservent ();
 507   if ((file = getenv (ENVIRON_ETC_SERVICES)) != NULL)
 508     strcpy (scm_i_servent.file, file);
 509   else if ((file = scm_i_socket_filename (FILE_ETC_SERVICES)) != NULL)
 510     strcpy (scm_i_servent.file, file);
 511   scm_i_servent.fd = fopen (scm_i_servent.file, "rt");
 512 }
 513
 514 /* The endservent() function closes the `/etc/services' file.  */
 515 void
 516 endservent (void)
 517 {
 518   if (scm_i_servent.fd != NULL)
 519     {
 520       fclose (scm_i_servent.fd);
 521       scm_i_servent.fd = NULL;
 522     }
 523 }
 524
 525 /* The getprotoent() function reads the next line from the file
 526    `/etc/protocols' and returns a structure protoent containing the broken
 527    out fields from the line. The `/etc/protocols' file is opened if
 528    necessary.  */
 529 struct protoent *
 530 getprotoent (void)
 531 {
 532   char line[MAX_NAMLEN], *end, *p;
 533   int done = 0, i, n, a;
 534   struct protoent *e = NULL;
 535
 536   /* Ensure a open file.  */
 537   if (scm_i_protoent.fd == NULL || feof (scm_i_protoent.fd))
 538     {
 539       setprotoent (1);
 540       if (scm_i_protoent.fd == NULL)
 541         return NULL;
 542     }
 543
 544   while (!done)
 545     {
 546       /* Get new line.  */
 547       if (fgets (line, MAX_NAMLEN, scm_i_protoent.fd) != NULL)
 548         {
 549           end = scm_i_socket_uncomment (line);
 550
 551           /* Scan the line.  */
 552           if ((i = sscanf (line, "%s %d%n",
 553                            scm_i_protoent.name,
 554                            &scm_i_protoent.proto, &n)) != 2)
 555             continue;
 556
 557           /* Scan the remaining aliases.  */
 558           p = line + n;
 559           for (a = 0; a < MAX_ALIASES && p < end && i != -1 && n > 1;
 560                a++, p += n)
 561             i = sscanf (p, "%s%n", scm_i_protoent.alias[a], &n);
 562
 563           /* Prepare the return value.  */
 564           e = &scm_i_protoent.ent;
 565           e->p_name = scm_i_protoent.name;
 566           e->p_proto = scm_i_protoent.proto;
 567           e->p_aliases = scm_i_protoent.aliases;
 568           scm_i_protoent.aliases[a] = NULL;
 569           while (a--)
 570             scm_i_protoent.aliases[a] = scm_i_protoent.alias[a];
 571           done = 1;
 572         }
 573       else
 574         break;
 575     }
 576   return done ? e : NULL;
 577 }
 578
 579 /* The setprotoent() function opens and rewinds the `/etc/protocols' file.
 580    As in setservent() the user can modify the location of the file using
 581    an environment variable.  */
 582 void
 583 setprotoent (int stayopen)
 584 {
 585   char *file = NULL;
 586
 587   endprotoent ();
 588   if ((file = getenv (ENVIRON_ETC_PROTOCOLS)) != NULL)
 589     strcpy (scm_i_protoent.file, file);
 590   else if ((file = scm_i_socket_filename (FILE_ETC_PROTOCOLS)) != NULL)
 591     strcpy (scm_i_protoent.file, file);
 592   scm_i_protoent.fd = fopen (scm_i_protoent.file, "rt");
 593 }
 594
 595 /* The endprotoent() function closes `/etc/protocols'.  */
 596 void
 597 endprotoent (void)
 598 {
 599   if (scm_i_protoent.fd != NULL)
 600     {
 601       fclose (scm_i_protoent.fd);
 602       scm_i_protoent.fd = NULL;
 603     }
 604 }
 605
 606 /* Define both the original and replacement error symbol is possible.  Thus
 607    the user is able to check symbolic errors after unsuccessful networking
 608    function calls.  */
 609 static void
 610 scm_socket_symbols_Win32 (socket_error_t * e)
 611 {
 612   while (e->error != -1)
 613     {
 614       if (e->error)
 615         {
 616           if (e->correct_str)
 617             scm_c_define (e->correct_str, scm_from_int (e->error));
 618           if (e->replace && e->replace_str)
 619             scm_c_define (e->replace_str, scm_from_int (e->replace));
 620         }
 621       e++;
 622     }
 623 }
 624
 625 /* Initialize Winsock API under M$-Windows.  */
 626 void
 627 scm_i_init_socket_Win32 (void)
 628 {
 629   scm_socket_symbols_Win32 (socket_errno);
 630   scm_socket_symbols_Win32 (socket_h_errno);
 631 }