xref: /openbsd-src/gnu/usr.bin/perl/win32/win32sck.c (revision 99fd087599a8791921855f21bd7e36130f39aadc)
1 /* win32sck.c
2  *
3  * (c) 1995 Microsoft Corporation. All rights reserved.
4  * 		Developed by hip communications inc.
5  * Portions (c) 1993 Intergraph Corporation. All rights reserved.
6  *
7  *    You may distribute under the terms of either the GNU General Public
8  *    License or the Artistic License, as specified in the README file.
9  */
10 
11 #define WIN32IO_IS_STDIO
12 #define WIN32SCK_IS_STDSCK
13 #define WIN32_LEAN_AND_MEAN
14 #define PERLIO_NOT_STDIO 0
15 #ifdef __GNUC__
16 #define Win32_Winsock
17 #endif
18 #include <windows.h>
19 #include <ws2spi.h>
20 
21 #include "EXTERN.h"
22 #include "perl.h"
23 
24 #include "Win32iop.h"
25 #include <sys/socket.h>
26 #include <fcntl.h>
27 #include <sys/stat.h>
28 #include <assert.h>
29 #include <io.h>
30 
31 /* thanks to Beverly Brown	(beverly@datacube.com) */
32 #define OPEN_SOCKET(x)	win32_open_osfhandle(x,O_RDWR|O_BINARY)
33 #define TO_SOCKET(x)	_get_osfhandle(x)
34 
35 #define StartSockets() \
36     STMT_START {					\
37 	if (!wsock_started)				\
38 	    start_sockets();				\
39     } STMT_END
40 
41 #define SOCKET_TEST(x, y) \
42     STMT_START {					\
43 	StartSockets();					\
44 	if((x) == (y))					\
45 	    {						\
46 	    int wsaerr = WSAGetLastError();		\
47 	    errno = convert_wsa_error_to_errno(wsaerr);	\
48 	    SetLastError(wsaerr);			\
49 	    }						\
50     } STMT_END
51 
52 #define SOCKET_TEST_ERROR(x) SOCKET_TEST(x, SOCKET_ERROR)
53 
54 static struct servent* win32_savecopyservent(struct servent*d,
55                                              struct servent*s,
56                                              const char *proto);
57 
58 static int wsock_started = 0;
59 
60 #ifdef WIN32_DYN_IOINFO_SIZE
61 EXTERN_C Size_t w32_ioinfo_size;
62 #endif
63 
64 EXTERN_C void
65 EndSockets(void)
66 {
67     if (wsock_started)
68 	WSACleanup();
69 }
70 
71 /* Translate WSAExxx values to corresponding Exxx values where possible. Not all
72  * WSAExxx constants have corresponding Exxx constants in <errno.h> (even in
73  * VC++ 2010 and above, which have expanded <errno.h> with more values), but
74  * most missing constants are provided by win32/include/sys/errno2.h. The few
75  * that are not are returned unchanged.
76  *
77  * The list of possible WSAExxx values used here comes from the MSDN page
78  * titled "Windows Sockets Error Codes".
79  *
80  * (Note: Only the WSAExxx values are handled here; other WSAxxx values are
81  * returned unchanged. The return value normally ends up in errno/$! and at
82  * the Perl code level may be tested against the Exxx constants exported by
83  * the Errno and POSIX modules, which have never handled the other WSAxxx
84  * values themselves, apparently without any ill effect so far.)
85  */
86 int
87 convert_wsa_error_to_errno(int wsaerr)
88 {
89     switch (wsaerr) {
90     case WSAEINTR:
91 	return EINTR;
92     case WSAEBADF:
93 	return EBADF;
94     case WSAEACCES:
95 	return EACCES;
96     case WSAEFAULT:
97 	return EFAULT;
98     case WSAEINVAL:
99 	return EINVAL;
100     case WSAEMFILE:
101 	return EMFILE;
102     case WSAEWOULDBLOCK:
103 	return EWOULDBLOCK;
104     case WSAEINPROGRESS:
105 	return EINPROGRESS;
106     case WSAEALREADY:
107 	return EALREADY;
108     case WSAENOTSOCK:
109 	return ENOTSOCK;
110     case WSAEDESTADDRREQ:
111 	return EDESTADDRREQ;
112     case WSAEMSGSIZE:
113 	return EMSGSIZE;
114     case WSAEPROTOTYPE:
115 	return EPROTOTYPE;
116     case WSAENOPROTOOPT:
117 	return ENOPROTOOPT;
118     case WSAEPROTONOSUPPORT:
119 	return EPROTONOSUPPORT;
120     case WSAESOCKTNOSUPPORT:
121 	return ESOCKTNOSUPPORT;
122     case WSAEOPNOTSUPP:
123 	return EOPNOTSUPP;
124     case WSAEPFNOSUPPORT:
125 	return EPFNOSUPPORT;
126     case WSAEAFNOSUPPORT:
127 	return EAFNOSUPPORT;
128     case WSAEADDRINUSE:
129 	return EADDRINUSE;
130     case WSAEADDRNOTAVAIL:
131 	return EADDRNOTAVAIL;
132     case WSAENETDOWN:
133 	return ENETDOWN;
134     case WSAENETUNREACH:
135 	return ENETUNREACH;
136     case WSAENETRESET:
137 	return ENETRESET;
138     case WSAECONNABORTED:
139 	return ECONNABORTED;
140     case WSAECONNRESET:
141 	return ECONNRESET;
142     case WSAENOBUFS:
143 	return ENOBUFS;
144     case WSAEISCONN:
145 	return EISCONN;
146     case WSAENOTCONN:
147 	return ENOTCONN;
148     case WSAESHUTDOWN:
149 	return ESHUTDOWN;
150     case WSAETOOMANYREFS:
151 	return ETOOMANYREFS;
152     case WSAETIMEDOUT:
153 	return ETIMEDOUT;
154     case WSAECONNREFUSED:
155 	return ECONNREFUSED;
156     case WSAELOOP:
157 	return ELOOP;
158     case WSAENAMETOOLONG:
159 	return ENAMETOOLONG;
160     case WSAEHOSTDOWN:
161 	return WSAEHOSTDOWN;		/* EHOSTDOWN is not defined */
162     case WSAEHOSTUNREACH:
163 	return EHOSTUNREACH;
164     case WSAENOTEMPTY:
165 	return ENOTEMPTY;
166     case WSAEPROCLIM:
167 	return EPROCLIM;
168     case WSAEUSERS:
169 	return EUSERS;
170     case WSAEDQUOT:
171 	return EDQUOT;
172     case WSAESTALE:
173 	return ESTALE;
174     case WSAEREMOTE:
175 	return EREMOTE;
176     case WSAEDISCON:
177 	return WSAEDISCON;		/* EDISCON is not defined */
178     case WSAENOMORE:
179 	return WSAENOMORE;		/* ENOMORE is not defined */
180 #ifdef WSAECANCELLED
181     case WSAECANCELLED:			/* New in WinSock2 */
182 	return ECANCELED;
183 #endif
184     case WSAEINVALIDPROCTABLE:
185 	return WSAEINVALIDPROCTABLE;	/* EINVALIDPROCTABLE is not defined */
186     case WSAEINVALIDPROVIDER:
187 	return WSAEINVALIDPROVIDER;	/* EINVALIDPROVIDER is not defined */
188     case WSAEPROVIDERFAILEDINIT:
189 	return WSAEPROVIDERFAILEDINIT;	/* EPROVIDERFAILEDINIT is not defined */
190     case WSAEREFUSED:
191 	return WSAEREFUSED;		/* EREFUSED is not defined */
192     }
193 
194     return wsaerr;
195 }
196 
197 #ifdef ERRNO_HAS_POSIX_SUPPLEMENT
198 /* Translate Exxx values in the POSIX supplement range defined in VC++ 2010 and
199  * above (EADDRINUSE <= err <= EWOULDBLOCK) to corresponding WSAExxx values. Not
200  * all such Exxx constants have corresponding WSAExxx constants in <winsock*.h>;
201  * we just use ERROR_INVALID_FUNCTION for those that are missing but do not
202  * really expect to encounter them anyway in the context in which this function
203  * is called.
204  * Some versions of MinGW/gcc-4.8 and above also define most, but not all, of
205  * these extra Exxx values. The missing ones are all cases for which there is no
206  * corresponding WSAExxx constant anyway, so we simply omit the cases for them
207  * here.
208  * Other Exxx values (err < sys_nerr) are returned unchanged.
209  */
210 int
211 convert_errno_to_wsa_error(int err)
212 {
213     switch (err) {
214     case EADDRINUSE:
215 	return WSAEADDRINUSE;
216     case EADDRNOTAVAIL:
217 	return WSAEADDRNOTAVAIL;
218     case EAFNOSUPPORT:
219 	return WSAEAFNOSUPPORT;
220     case EALREADY:
221 	return WSAEALREADY;
222 #ifdef EBADMSG
223     case EBADMSG:			/* Not defined in gcc-4.8.0 */
224 	return ERROR_INVALID_FUNCTION;
225 #endif
226     case ECANCELED:
227 #ifdef WSAECANCELLED
228 	return WSAECANCELLED;		/* New in WinSock2 */
229 #else
230 	return ERROR_INVALID_FUNCTION;
231 #endif
232     case ECONNABORTED:
233 	return WSAECONNABORTED;
234     case ECONNREFUSED:
235 	return WSAECONNREFUSED;
236     case ECONNRESET:
237 	return WSAECONNRESET;
238     case EDESTADDRREQ:
239 	return WSAEDESTADDRREQ;
240     case EHOSTUNREACH:
241 	return WSAEHOSTUNREACH;
242 #ifdef EIDRM
243     case EIDRM:				/* Not defined in gcc-4.8.0 */
244 	return ERROR_INVALID_FUNCTION;
245 #endif
246     case EINPROGRESS:
247 	return WSAEINPROGRESS;
248     case EISCONN:
249 	return WSAEISCONN;
250     case ELOOP:
251 	return WSAELOOP;
252     case EMSGSIZE:
253 	return WSAEMSGSIZE;
254     case ENETDOWN:
255 	return WSAENETDOWN;
256     case ENETRESET:
257 	return WSAENETRESET;
258     case ENETUNREACH:
259 	return WSAENETUNREACH;
260     case ENOBUFS:
261 	return WSAENOBUFS;
262 #ifdef ENODATA
263     case ENODATA:			/* Not defined in gcc-4.8.0 */
264 	return ERROR_INVALID_FUNCTION;
265 #endif
266 #ifdef ENOLINK
267     case ENOLINK:			/* Not defined in gcc-4.8.0 */
268 	return ERROR_INVALID_FUNCTION;
269 #endif
270 #ifdef ENOMSG
271     case ENOMSG:			/* Not defined in gcc-4.8.0 */
272 	return ERROR_INVALID_FUNCTION;
273 #endif
274     case ENOPROTOOPT:
275 	return WSAENOPROTOOPT;
276 #ifdef ENOSR
277     case ENOSR:				/* Not defined in gcc-4.8.0 */
278 	return ERROR_INVALID_FUNCTION;
279 #endif
280 #ifdef ENOSTR
281     case ENOSTR:			/* Not defined in gcc-4.8.0 */
282 	return ERROR_INVALID_FUNCTION;
283 #endif
284     case ENOTCONN:
285 	return WSAENOTCONN;
286 #ifdef ENOTRECOVERABLE
287     case ENOTRECOVERABLE:		/* Not defined in gcc-4.8.0 */
288 	return ERROR_INVALID_FUNCTION;
289 #endif
290     case ENOTSOCK:
291 	return WSAENOTSOCK;
292     case ENOTSUP:
293 	return ERROR_INVALID_FUNCTION;
294     case EOPNOTSUPP:
295 	return WSAEOPNOTSUPP;
296 #ifdef EOTHER
297     case EOTHER:			/* Not defined in gcc-4.8.0 */
298 	return ERROR_INVALID_FUNCTION;
299 #endif
300     case EOVERFLOW:
301 	return ERROR_INVALID_FUNCTION;
302     case EOWNERDEAD:
303 	return ERROR_INVALID_FUNCTION;
304     case EPROTO:
305 	return ERROR_INVALID_FUNCTION;
306     case EPROTONOSUPPORT:
307 	return WSAEPROTONOSUPPORT;
308     case EPROTOTYPE:
309 	return WSAEPROTOTYPE;
310 #ifdef ETIME
311     case ETIME:				/* Not defined in gcc-4.8.0 */
312 	return ERROR_INVALID_FUNCTION;
313 #endif
314     case ETIMEDOUT:
315 	return WSAETIMEDOUT;
316 #ifdef ETXTBSY
317     case ETXTBSY:			/* Not defined in gcc-4.8.0 */
318 	return ERROR_INVALID_FUNCTION;
319 #endif
320     case EWOULDBLOCK:
321 	return WSAEWOULDBLOCK;
322     }
323 
324     return err;
325 }
326 #endif /* ERRNO_HAS_POSIX_SUPPLEMENT */
327 
328 void
329 start_sockets(void)
330 {
331     unsigned short version;
332     WSADATA retdata;
333     int ret;
334 
335     /*
336      * initalize the winsock interface and insure that it is
337      * cleaned up at exit.
338      */
339     version = 0x2;
340     if(ret = WSAStartup(version, &retdata))
341 	Perl_croak_nocontext("Unable to locate winsock library!\n");
342     if(retdata.wVersion != version)
343 	Perl_croak_nocontext("Could not find version 2.0 of winsock dll\n");
344 
345     /* atexit((void (*)(void)) EndSockets); */
346     wsock_started = 1;
347 }
348 
349 /* in no sockets Win32 builds, these use the inline functions defined in
350  * perl.h
351  */
352 u_long
353 win32_htonl(u_long hostlong)
354 {
355 #ifndef WIN32_NO_SOCKETS
356     StartSockets();
357 #endif
358     return htonl(hostlong);
359 }
360 
361 u_short
362 win32_htons(u_short hostshort)
363 {
364 #ifndef WIN32_NO_SOCKETS
365     StartSockets();
366 #endif
367     return htons(hostshort);
368 }
369 
370 u_long
371 win32_ntohl(u_long netlong)
372 {
373 #ifndef WIN32_NO_SOCKETS
374     StartSockets();
375 #endif
376     return ntohl(netlong);
377 }
378 
379 u_short
380 win32_ntohs(u_short netshort)
381 {
382 #ifndef WIN32_NO_SOCKETS
383     StartSockets();
384 #endif
385     return ntohs(netshort);
386 }
387 
388 
389 
390 SOCKET
391 win32_accept(SOCKET s, struct sockaddr *addr, int *addrlen)
392 {
393     SOCKET r;
394 
395     SOCKET_TEST((r = accept(TO_SOCKET(s), addr, addrlen)), INVALID_SOCKET);
396     return OPEN_SOCKET(r);
397 }
398 
399 int
400 win32_bind(SOCKET s, const struct sockaddr *addr, int addrlen)
401 {
402     int r;
403 
404     SOCKET_TEST_ERROR(r = bind(TO_SOCKET(s), addr, addrlen));
405     return r;
406 }
407 
408 int
409 win32_connect(SOCKET s, const struct sockaddr *addr, int addrlen)
410 {
411     int r;
412 
413     SOCKET_TEST_ERROR(r = connect(TO_SOCKET(s), addr, addrlen));
414     return r;
415 }
416 
417 
418 int
419 win32_getpeername(SOCKET s, struct sockaddr *addr, int *addrlen)
420 {
421     int r;
422 
423     SOCKET_TEST_ERROR(r = getpeername(TO_SOCKET(s), addr, addrlen));
424     return r;
425 }
426 
427 int
428 win32_getsockname(SOCKET s, struct sockaddr *addr, int *addrlen)
429 {
430     int r;
431 
432     SOCKET_TEST_ERROR(r = getsockname(TO_SOCKET(s), addr, addrlen));
433     return r;
434 }
435 
436 int
437 win32_getsockopt(SOCKET s, int level, int optname, char *optval, int *optlen)
438 {
439     int r;
440 
441     SOCKET_TEST_ERROR(r = getsockopt(TO_SOCKET(s), level, optname, optval, optlen));
442     return r;
443 }
444 
445 int
446 win32_ioctlsocket(SOCKET s, long cmd, u_long *argp)
447 {
448     int r;
449 
450     SOCKET_TEST_ERROR(r = ioctlsocket(TO_SOCKET(s), cmd, argp));
451     return r;
452 }
453 
454 int
455 win32_listen(SOCKET s, int backlog)
456 {
457     int r;
458 
459     SOCKET_TEST_ERROR(r = listen(TO_SOCKET(s), backlog));
460     return r;
461 }
462 
463 int
464 win32_recv(SOCKET s, char *buf, int len, int flags)
465 {
466     int r;
467 
468     SOCKET_TEST_ERROR(r = recv(TO_SOCKET(s), buf, len, flags));
469     return r;
470 }
471 
472 int
473 win32_recvfrom(SOCKET s, char *buf, int len, int flags, struct sockaddr *from, int *fromlen)
474 {
475     int r;
476     int frombufsize = *fromlen;
477 
478     SOCKET_TEST_ERROR(r = recvfrom(TO_SOCKET(s), buf, len, flags, from, fromlen));
479     /* Winsock's recvfrom() only returns a valid 'from' when the socket
480      * is connectionless.  Perl expects a valid 'from' for all types
481      * of sockets, so go the extra mile.
482      */
483     if (r != SOCKET_ERROR && frombufsize == *fromlen)
484 	(void)win32_getpeername(s, from, fromlen);
485     return r;
486 }
487 
488 /* select contributed by Vincent R. Slyngstad (vrs@ibeam.intel.com) */
489 int
490 win32_select(int nfds, Perl_fd_set* rd, Perl_fd_set* wr, Perl_fd_set* ex, const struct timeval* timeout)
491 {
492     int r;
493     int i, fd, save_errno = errno;
494     FD_SET nrd, nwr, nex;
495     bool just_sleep = TRUE;
496 
497     StartSockets();
498 
499     FD_ZERO(&nrd);
500     FD_ZERO(&nwr);
501     FD_ZERO(&nex);
502     for (i = 0; i < nfds; i++) {
503 	if (rd && PERL_FD_ISSET(i,rd)) {
504 	    fd = TO_SOCKET(i);
505 	    FD_SET((unsigned)fd, &nrd);
506             just_sleep = FALSE;
507 	}
508 	if (wr && PERL_FD_ISSET(i,wr)) {
509 	    fd = TO_SOCKET(i);
510 	    FD_SET((unsigned)fd, &nwr);
511             just_sleep = FALSE;
512 	}
513 	if (ex && PERL_FD_ISSET(i,ex)) {
514 	    fd = TO_SOCKET(i);
515 	    FD_SET((unsigned)fd, &nex);
516             just_sleep = FALSE;
517 	}
518     }
519 
520     /* winsock seems incapable of dealing with all three fd_sets being empty,
521      * so do the (millisecond) sleep as a special case
522      */
523     if (just_sleep) {
524 	if (timeout)
525 	    Sleep(timeout->tv_sec  * 1000 +
526 		  timeout->tv_usec / 1000);	/* do the best we can */
527 	else
528 	    Sleep(UINT_MAX);
529 	return 0;
530     }
531 
532     errno = save_errno;
533     SOCKET_TEST_ERROR(r = select(nfds, &nrd, &nwr, &nex, (PTIMEVAL)timeout));
534     save_errno = errno;
535 
536     for (i = 0; i < nfds; i++) {
537 	if (rd && PERL_FD_ISSET(i,rd)) {
538 	    fd = TO_SOCKET(i);
539 	    if (!FD_ISSET(fd, &nrd))
540 		PERL_FD_CLR(i,rd);
541 	}
542 	if (wr && PERL_FD_ISSET(i,wr)) {
543 	    fd = TO_SOCKET(i);
544 	    if (!FD_ISSET(fd, &nwr))
545 		PERL_FD_CLR(i,wr);
546 	}
547 	if (ex && PERL_FD_ISSET(i,ex)) {
548 	    fd = TO_SOCKET(i);
549 	    if (!FD_ISSET(fd, &nex))
550 		PERL_FD_CLR(i,ex);
551 	}
552     }
553     errno = save_errno;
554     return r;
555 }
556 
557 int
558 win32_send(SOCKET s, const char *buf, int len, int flags)
559 {
560     int r;
561 
562     SOCKET_TEST_ERROR(r = send(TO_SOCKET(s), buf, len, flags));
563     return r;
564 }
565 
566 int
567 win32_sendto(SOCKET s, const char *buf, int len, int flags,
568 	     const struct sockaddr *to, int tolen)
569 {
570     int r;
571 
572     SOCKET_TEST_ERROR(r = sendto(TO_SOCKET(s), buf, len, flags, to, tolen));
573     return r;
574 }
575 
576 int
577 win32_setsockopt(SOCKET s, int level, int optname, const char *optval, int optlen)
578 {
579     int r;
580 
581     SOCKET_TEST_ERROR(r = setsockopt(TO_SOCKET(s), level, optname, optval, optlen));
582     return r;
583 }
584 
585 int
586 win32_shutdown(SOCKET s, int how)
587 {
588     int r;
589 
590     SOCKET_TEST_ERROR(r = shutdown(TO_SOCKET(s), how));
591     return r;
592 }
593 
594 int
595 win32_closesocket(SOCKET s)
596 {
597     int r;
598 
599     SOCKET_TEST_ERROR(r = closesocket(TO_SOCKET(s)));
600     return r;
601 }
602 
603 void
604 convert_proto_info_w2a(WSAPROTOCOL_INFOW *in, WSAPROTOCOL_INFOA *out)
605 {
606     Copy(in, out, 1, WSAPROTOCOL_INFOA);
607     wcstombs(out->szProtocol, in->szProtocol, sizeof(out->szProtocol));
608 }
609 
610 SOCKET
611 open_ifs_socket(int af, int type, int protocol)
612 {
613     dTHX;
614     char *s;
615     unsigned long proto_buffers_len = 0;
616     int error_code, found = 0;
617     SOCKET out = INVALID_SOCKET;
618 
619     if ((s = PerlEnv_getenv("PERL_ALLOW_NON_IFS_LSP")) && atoi(s))
620         return WSASocket(af, type, protocol, NULL, 0, 0);
621 
622     if (WSCEnumProtocols(NULL, NULL, &proto_buffers_len, &error_code) == SOCKET_ERROR
623         && error_code == WSAENOBUFS)
624     {
625 	WSAPROTOCOL_INFOW *proto_buffers;
626         int protocols_available = 0;
627 
628         Newx(proto_buffers, proto_buffers_len / sizeof(WSAPROTOCOL_INFOW),
629             WSAPROTOCOL_INFOW);
630 
631         if ((protocols_available = WSCEnumProtocols(NULL, proto_buffers,
632             &proto_buffers_len, &error_code)) != SOCKET_ERROR)
633         {
634             int i;
635             for (i = 0; i < protocols_available; i++)
636             {
637                 WSAPROTOCOL_INFOA proto_info;
638 
639                 if ((af != AF_UNSPEC && af != proto_buffers[i].iAddressFamily)
640                     || (type != proto_buffers[i].iSocketType)
641                     || (protocol != 0 && proto_buffers[i].iProtocol != 0 &&
642                         protocol != proto_buffers[i].iProtocol))
643                     continue;
644 
645                 if ((proto_buffers[i].dwServiceFlags1 & XP1_IFS_HANDLES) == 0)
646                     continue;
647 
648                 found = 1;
649                 convert_proto_info_w2a(&(proto_buffers[i]), &proto_info);
650 
651                 out = WSASocket(af, type, protocol, &proto_info, 0, 0);
652                 break;
653             }
654 
655             if (!found)
656                 WSASetLastError(WSAEPROTONOSUPPORT);
657         }
658 
659         Safefree(proto_buffers);
660     }
661 
662     return out;
663 }
664 
665 SOCKET
666 win32_socket(int af, int type, int protocol)
667 {
668     SOCKET s;
669 
670     StartSockets();
671 
672     if((s = open_ifs_socket(af, type, protocol)) == INVALID_SOCKET)
673         {
674 	int wsaerr = WSAGetLastError();
675 	errno = convert_wsa_error_to_errno(wsaerr);
676 	SetLastError(wsaerr);
677 	}
678     else
679 	s = OPEN_SOCKET(s);
680 
681     return s;
682 }
683 
684 /*
685  * close RTL fd while respecting sockets
686  * added as temporary measure until PerlIO has real
687  * Win32 native layer
688  *   -- BKS, 11-11-2000
689 */
690 
691 int my_close(int fd)
692 {
693     int osf;
694     if (!wsock_started)		/* No WinSock? */
695 	return(close(fd));	/* Then not a socket. */
696     osf = TO_SOCKET(fd);/* Get it now before it's gone! */
697     if (osf != -1) {
698 	int err;
699 	err = closesocket(osf);
700 	if (err == 0) {
701 #ifdef _set_osfhnd
702 	    assert(_osfhnd(fd) == osf); /* catch a bad ioinfo struct def */
703 	    /* don't close freed handle */
704 	    _set_osfhnd(fd, INVALID_HANDLE_VALUE);
705 	    return close(fd);
706 #else
707 	    (void)close(fd);    /* handle already closed, ignore error */
708 	    return 0;
709 #endif
710 	}
711 	else if (err == SOCKET_ERROR) {
712 	    int wsaerr = WSAGetLastError();
713 	    err = convert_wsa_error_to_errno(wsaerr);
714 	    if (err != ENOTSOCK) {
715 		(void)close(fd);
716 		errno = err;
717 		SetLastError(wsaerr);
718 		return EOF;
719 	    }
720 	}
721     }
722     return close(fd);
723 }
724 
725 #undef fclose
726 int
727 my_fclose (FILE *pf)
728 {
729     int osf;
730     if (!wsock_started)		/* No WinSock? */
731 	return(fclose(pf));	/* Then not a socket. */
732     osf = TO_SOCKET(win32_fileno(pf));/* Get it now before it's gone! */
733     if (osf != -1) {
734 	int err;
735 	win32_fflush(pf);
736 	err = closesocket(osf);
737 	if (err == 0) {
738 #ifdef _set_osfhnd
739 	    assert(_osfhnd(win32_fileno(pf)) == osf); /* catch a bad ioinfo struct def */
740 	    /* don't close freed handle */
741 	    _set_osfhnd(win32_fileno(pf), INVALID_HANDLE_VALUE);
742 	    return fclose(pf);
743 #else
744 	    (void)fclose(pf);   /* handle already closed, ignore error */
745 	    return 0;
746 #endif
747 	}
748 	else if (err == SOCKET_ERROR) {
749 	    int wsaerr = WSAGetLastError();
750 	    err = convert_wsa_error_to_errno(wsaerr);
751 	    if (err != ENOTSOCK) {
752 		(void)fclose(pf);
753 		errno = err;
754 		SetLastError(wsaerr);
755 		return EOF;
756 	    }
757 	}
758     }
759     return fclose(pf);
760 }
761 
762 struct hostent *
763 win32_gethostbyaddr(const char *addr, int len, int type)
764 {
765     struct hostent *r;
766 
767     SOCKET_TEST(r = gethostbyaddr(addr, len, type), NULL);
768     return r;
769 }
770 
771 struct hostent *
772 win32_gethostbyname(const char *name)
773 {
774     struct hostent *r;
775 
776     SOCKET_TEST(r = gethostbyname(name), NULL);
777     return r;
778 }
779 
780 int
781 win32_gethostname(char *name, int len)
782 {
783     int r;
784 
785     SOCKET_TEST_ERROR(r = gethostname(name, len));
786     return r;
787 }
788 
789 struct protoent *
790 win32_getprotobyname(const char *name)
791 {
792     struct protoent *r;
793 
794     SOCKET_TEST(r = getprotobyname(name), NULL);
795     return r;
796 }
797 
798 struct protoent *
799 win32_getprotobynumber(int num)
800 {
801     struct protoent *r;
802 
803     SOCKET_TEST(r = getprotobynumber(num), NULL);
804     return r;
805 }
806 
807 struct servent *
808 win32_getservbyname(const char *name, const char *proto)
809 {
810     dTHXa(NULL);
811     struct servent *r;
812 
813     SOCKET_TEST(r = getservbyname(name, proto), NULL);
814     if (r) {
815         aTHXa(PERL_GET_THX);
816 	r = win32_savecopyservent(&w32_servent, r, proto);
817     }
818     return r;
819 }
820 
821 struct servent *
822 win32_getservbyport(int port, const char *proto)
823 {
824     dTHXa(NULL);
825     struct servent *r;
826 
827     SOCKET_TEST(r = getservbyport(port, proto), NULL);
828     if (r) {
829         aTHXa(PERL_GET_THX);
830 	r = win32_savecopyservent(&w32_servent, r, proto);
831     }
832     return r;
833 }
834 
835 int
836 win32_ioctl(int i, unsigned int u, char *data)
837 {
838     u_long u_long_arg;
839     int retval;
840 
841     if (!wsock_started) {
842 	Perl_croak_nocontext("ioctl implemented only on sockets");
843 	/* NOTREACHED */
844     }
845 
846     /* mauke says using memcpy avoids alignment issues */
847     memcpy(&u_long_arg, data, sizeof u_long_arg);
848     retval = ioctlsocket(TO_SOCKET(i), (long)u, &u_long_arg);
849     memcpy(data, &u_long_arg, sizeof u_long_arg);
850 
851     if (retval == SOCKET_ERROR) {
852 	int wsaerr = WSAGetLastError();
853 	int err = convert_wsa_error_to_errno(wsaerr);
854 	if (err == ENOTSOCK) {
855 	    Perl_croak_nocontext("ioctl implemented only on sockets");
856 	    /* NOTREACHED */
857 	}
858 	errno = err;
859 	SetLastError(wsaerr);
860     }
861     return retval;
862 }
863 
864 char FAR *
865 win32_inet_ntoa(struct in_addr in)
866 {
867     StartSockets();
868     return inet_ntoa(in);
869 }
870 
871 unsigned long
872 win32_inet_addr(const char FAR *cp)
873 {
874     StartSockets();
875     return inet_addr(cp);
876 }
877 
878 /*
879  * Networking stubs
880  */
881 
882 void
883 win32_endhostent()
884 {
885     win32_croak_not_implemented("endhostent");
886 }
887 
888 void
889 win32_endnetent()
890 {
891     win32_croak_not_implemented("endnetent");
892 }
893 
894 void
895 win32_endprotoent()
896 {
897     win32_croak_not_implemented("endprotoent");
898 }
899 
900 void
901 win32_endservent()
902 {
903     win32_croak_not_implemented("endservent");
904 }
905 
906 
907 struct netent *
908 win32_getnetent(void)
909 {
910     win32_croak_not_implemented("getnetent");
911     return (struct netent *) NULL;
912 }
913 
914 struct netent *
915 win32_getnetbyname(char *name)
916 {
917     win32_croak_not_implemented("getnetbyname");
918     return (struct netent *)NULL;
919 }
920 
921 struct netent *
922 win32_getnetbyaddr(long net, int type)
923 {
924     win32_croak_not_implemented("getnetbyaddr");
925     return (struct netent *)NULL;
926 }
927 
928 struct protoent *
929 win32_getprotoent(void)
930 {
931     win32_croak_not_implemented("getprotoent");
932     return (struct protoent *) NULL;
933 }
934 
935 struct servent *
936 win32_getservent(void)
937 {
938     win32_croak_not_implemented("getservent");
939     return (struct servent *) NULL;
940 }
941 
942 void
943 win32_sethostent(int stayopen)
944 {
945     win32_croak_not_implemented("sethostent");
946 }
947 
948 
949 void
950 win32_setnetent(int stayopen)
951 {
952     win32_croak_not_implemented("setnetent");
953 }
954 
955 
956 void
957 win32_setprotoent(int stayopen)
958 {
959     win32_croak_not_implemented("setprotoent");
960 }
961 
962 
963 void
964 win32_setservent(int stayopen)
965 {
966     win32_croak_not_implemented("setservent");
967 }
968 
969 static struct servent*
970 win32_savecopyservent(struct servent*d, struct servent*s, const char *proto)
971 {
972     d->s_name = s->s_name;
973     d->s_aliases = s->s_aliases;
974     d->s_port = s->s_port;
975     if (s->s_proto && strlen(s->s_proto))
976 	d->s_proto = s->s_proto;
977     else
978     if (proto && strlen(proto))
979 	d->s_proto = (char *)proto;
980     else
981 	d->s_proto = "tcp";
982 
983     return d;
984 }
985 
986 
987