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