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