This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Deparse.pm: handle optimised-away keys() better
[perl5.git] / win32 / win32sck.c
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;
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                 convert_proto_info_w2a(&(proto_buffers[i]), &proto_info);
649
650                 out = WSASocket(af, type, protocol, &proto_info, 0, 0);
651                 break;
652             }
653         }
654
655         Safefree(proto_buffers);
656     }
657
658     return out;
659 }
660
661 SOCKET
662 win32_socket(int af, int type, int protocol)
663 {
664     SOCKET s;
665
666     StartSockets();
667
668     if((s = open_ifs_socket(af, type, protocol)) == INVALID_SOCKET)
669         {
670         int wsaerr = WSAGetLastError();
671         errno = convert_wsa_error_to_errno(wsaerr);
672         SetLastError(wsaerr);
673         }
674     else
675         s = OPEN_SOCKET(s);
676
677     return s;
678 }
679
680 /*
681  * close RTL fd while respecting sockets
682  * added as temporary measure until PerlIO has real
683  * Win32 native layer
684  *   -- BKS, 11-11-2000
685 */
686
687 int my_close(int fd)
688 {
689     int osf;
690     if (!wsock_started)         /* No WinSock? */
691         return(close(fd));      /* Then not a socket. */
692     osf = TO_SOCKET(fd);/* Get it now before it's gone! */
693     if (osf != -1) {
694         int err;
695         err = closesocket(osf);
696         if (err == 0) {
697 #ifdef _set_osfhnd
698             assert(_osfhnd(fd) == osf); /* catch a bad ioinfo struct def */
699             /* don't close freed handle */
700             _set_osfhnd(fd, INVALID_HANDLE_VALUE);
701             return close(fd);
702 #else
703             (void)close(fd);    /* handle already closed, ignore error */
704             return 0;
705 #endif
706         }
707         else if (err == SOCKET_ERROR) {
708             int wsaerr = WSAGetLastError();
709             err = convert_wsa_error_to_errno(wsaerr);
710             if (err != ENOTSOCK) {
711                 (void)close(fd);
712                 errno = err;
713                 SetLastError(wsaerr);
714                 return EOF;
715             }
716         }
717     }
718     return close(fd);
719 }
720
721 #undef fclose
722 int
723 my_fclose (FILE *pf)
724 {
725     int osf;
726     if (!wsock_started)         /* No WinSock? */
727         return(fclose(pf));     /* Then not a socket. */
728     osf = TO_SOCKET(win32_fileno(pf));/* Get it now before it's gone! */
729     if (osf != -1) {
730         int err;
731         win32_fflush(pf);
732         err = closesocket(osf);
733         if (err == 0) {
734 #ifdef _set_osfhnd
735             assert(_osfhnd(win32_fileno(pf)) == osf); /* catch a bad ioinfo struct def */
736             /* don't close freed handle */
737             _set_osfhnd(win32_fileno(pf), INVALID_HANDLE_VALUE);
738             return fclose(pf);
739 #else
740             (void)fclose(pf);   /* handle already closed, ignore error */
741             return 0;
742 #endif
743         }
744         else if (err == SOCKET_ERROR) {
745             int wsaerr = WSAGetLastError();
746             err = convert_wsa_error_to_errno(wsaerr);
747             if (err != ENOTSOCK) {
748                 (void)fclose(pf);
749                 errno = err;
750                 SetLastError(wsaerr);
751                 return EOF;
752             }
753         }
754     }
755     return fclose(pf);
756 }
757
758 struct hostent *
759 win32_gethostbyaddr(const char *addr, int len, int type)
760 {
761     struct hostent *r;
762
763     SOCKET_TEST(r = gethostbyaddr(addr, len, type), NULL);
764     return r;
765 }
766
767 struct hostent *
768 win32_gethostbyname(const char *name)
769 {
770     struct hostent *r;
771
772     SOCKET_TEST(r = gethostbyname(name), NULL);
773     return r;
774 }
775
776 int
777 win32_gethostname(char *name, int len)
778 {
779     int r;
780
781     SOCKET_TEST_ERROR(r = gethostname(name, len));
782     return r;
783 }
784
785 struct protoent *
786 win32_getprotobyname(const char *name)
787 {
788     struct protoent *r;
789
790     SOCKET_TEST(r = getprotobyname(name), NULL);
791     return r;
792 }
793
794 struct protoent *
795 win32_getprotobynumber(int num)
796 {
797     struct protoent *r;
798
799     SOCKET_TEST(r = getprotobynumber(num), NULL);
800     return r;
801 }
802
803 struct servent *
804 win32_getservbyname(const char *name, const char *proto)
805 {
806     dTHXa(NULL);    
807     struct servent *r;
808
809     SOCKET_TEST(r = getservbyname(name, proto), NULL);
810     if (r) {
811         aTHXa(PERL_GET_THX);
812         r = win32_savecopyservent(&w32_servent, r, proto);
813     }
814     return r;
815 }
816
817 struct servent *
818 win32_getservbyport(int port, const char *proto)
819 {
820     dTHXa(NULL); 
821     struct servent *r;
822
823     SOCKET_TEST(r = getservbyport(port, proto), NULL);
824     if (r) {
825         aTHXa(PERL_GET_THX);
826         r = win32_savecopyservent(&w32_servent, r, proto);
827     }
828     return r;
829 }
830
831 int
832 win32_ioctl(int i, unsigned int u, char *data)
833 {
834     u_long u_long_arg; 
835     int retval;
836     
837     if (!wsock_started) {
838         Perl_croak_nocontext("ioctl implemented only on sockets");
839         /* NOTREACHED */
840     }
841
842     /* mauke says using memcpy avoids alignment issues */
843     memcpy(&u_long_arg, data, sizeof u_long_arg); 
844     retval = ioctlsocket(TO_SOCKET(i), (long)u, &u_long_arg);
845     memcpy(data, &u_long_arg, sizeof u_long_arg);
846     
847     if (retval == SOCKET_ERROR) {
848         int wsaerr = WSAGetLastError();
849         int err = convert_wsa_error_to_errno(wsaerr);
850         if (err == ENOTSOCK) {
851             Perl_croak_nocontext("ioctl implemented only on sockets");
852             /* NOTREACHED */
853         }
854         errno = err;
855         SetLastError(wsaerr);
856     }
857     return retval;
858 }
859
860 char FAR *
861 win32_inet_ntoa(struct in_addr in)
862 {
863     StartSockets();
864     return inet_ntoa(in);
865 }
866
867 unsigned long
868 win32_inet_addr(const char FAR *cp)
869 {
870     StartSockets();
871     return inet_addr(cp);
872 }
873
874 /*
875  * Networking stubs
876  */
877
878 void
879 win32_endhostent() 
880 {
881     win32_croak_not_implemented("endhostent");
882 }
883
884 void
885 win32_endnetent()
886 {
887     win32_croak_not_implemented("endnetent");
888 }
889
890 void
891 win32_endprotoent()
892 {
893     win32_croak_not_implemented("endprotoent");
894 }
895
896 void
897 win32_endservent()
898 {
899     win32_croak_not_implemented("endservent");
900 }
901
902
903 struct netent *
904 win32_getnetent(void) 
905 {
906     win32_croak_not_implemented("getnetent");
907     return (struct netent *) NULL;
908 }
909
910 struct netent *
911 win32_getnetbyname(char *name) 
912 {
913     win32_croak_not_implemented("getnetbyname");
914     return (struct netent *)NULL;
915 }
916
917 struct netent *
918 win32_getnetbyaddr(long net, int type) 
919 {
920     win32_croak_not_implemented("getnetbyaddr");
921     return (struct netent *)NULL;
922 }
923
924 struct protoent *
925 win32_getprotoent(void) 
926 {
927     win32_croak_not_implemented("getprotoent");
928     return (struct protoent *) NULL;
929 }
930
931 struct servent *
932 win32_getservent(void) 
933 {
934     win32_croak_not_implemented("getservent");
935     return (struct servent *) NULL;
936 }
937
938 void
939 win32_sethostent(int stayopen)
940 {
941     win32_croak_not_implemented("sethostent");
942 }
943
944
945 void
946 win32_setnetent(int stayopen)
947 {
948     win32_croak_not_implemented("setnetent");
949 }
950
951
952 void
953 win32_setprotoent(int stayopen)
954 {
955     win32_croak_not_implemented("setprotoent");
956 }
957
958
959 void
960 win32_setservent(int stayopen)
961 {
962     win32_croak_not_implemented("setservent");
963 }
964
965 static struct servent*
966 win32_savecopyservent(struct servent*d, struct servent*s, const char *proto)
967 {
968     d->s_name = s->s_name;
969     d->s_aliases = s->s_aliases;
970     d->s_port = s->s_port;
971     if (s->s_proto && strlen(s->s_proto))
972         d->s_proto = s->s_proto;
973     else
974     if (proto && strlen(proto))
975         d->s_proto = (char *)proto;
976     else
977         d->s_proto = "tcp";
978    
979     return d;
980 }
981
982