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