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