This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Defer loading main module
[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 #ifdef USE_SOCKETS_AS_HANDLES
33 #       define OPEN_SOCKET(x)   win32_open_osfhandle(x,O_RDWR|O_BINARY)
34 #       define TO_SOCKET(x)     _get_osfhandle(x)
35 #else
36 #       define OPEN_SOCKET(x)   (x)
37 #       define TO_SOCKET(x)     (x)
38 #endif  /* USE_SOCKETS_AS_HANDLES */
39
40 #define StartSockets() \
41     STMT_START {                                        \
42         if (!wsock_started)                             \
43             start_sockets();                            \
44     } STMT_END
45
46 #define SOCKET_TEST(x, y) \
47     STMT_START {                                        \
48         StartSockets();                                 \
49         if((x) == (y))                                  \
50             errno = WSAGetLastError();                  \
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 EXTERN_C void
62 EndSockets(void)
63 {
64     if (wsock_started)
65         WSACleanup();
66 }
67
68 void
69 start_sockets(void) 
70 {
71     dTHX;
72     unsigned short version;
73     WSADATA retdata;
74     int ret;
75
76     /*
77      * initalize the winsock interface and insure that it is
78      * cleaned up at exit.
79      */
80     version = 0x2;
81     if(ret = WSAStartup(version, &retdata))
82         Perl_croak_nocontext("Unable to locate winsock library!\n");
83     if(retdata.wVersion != version)
84         Perl_croak_nocontext("Could not find version 2.0 of winsock dll\n");
85
86     /* atexit((void (*)(void)) EndSockets); */
87     wsock_started = 1;
88 }
89
90 #ifndef USE_SOCKETS_AS_HANDLES
91 #undef fdopen
92 FILE *
93 my_fdopen(int fd, char *mode)
94 {
95     FILE *fp;
96     char sockbuf[256];
97     int optlen = sizeof(sockbuf);
98     int retval;
99
100     if (!wsock_started)
101         return(fdopen(fd, mode));
102
103     retval = getsockopt((SOCKET)fd, SOL_SOCKET, SO_TYPE, sockbuf, &optlen);
104     if(retval == SOCKET_ERROR && WSAGetLastError() == WSAENOTSOCK) {
105         return(fdopen(fd, mode));
106     }
107
108     /*
109      * If we get here, then fd is actually a socket.
110      */
111     Newxz(fp, 1, FILE); /* XXX leak, good thing this code isn't used */
112     if(fp == NULL) {
113         errno = ENOMEM;
114         return NULL;
115     }
116
117     fp->_file = fd;
118     if(*mode == 'r')
119         fp->_flag = _IOREAD;
120     else
121         fp->_flag = _IOWRT;
122    
123     return fp;
124 }
125 #endif  /* USE_SOCKETS_AS_HANDLES */
126
127
128 u_long
129 win32_htonl(u_long hostlong)
130 {
131     StartSockets();
132     return htonl(hostlong);
133 }
134
135 u_short
136 win32_htons(u_short hostshort)
137 {
138     StartSockets();
139     return htons(hostshort);
140 }
141
142 u_long
143 win32_ntohl(u_long netlong)
144 {
145     StartSockets();
146     return ntohl(netlong);
147 }
148
149 u_short
150 win32_ntohs(u_short netshort)
151 {
152     StartSockets();
153     return ntohs(netshort);
154 }
155
156
157
158 SOCKET
159 win32_accept(SOCKET s, struct sockaddr *addr, int *addrlen)
160 {
161     SOCKET r;
162
163     SOCKET_TEST((r = accept(TO_SOCKET(s), addr, addrlen)), INVALID_SOCKET);
164     return OPEN_SOCKET(r);
165 }
166
167 int
168 win32_bind(SOCKET s, const struct sockaddr *addr, int addrlen)
169 {
170     int r;
171
172     SOCKET_TEST_ERROR(r = bind(TO_SOCKET(s), addr, addrlen));
173     return r;
174 }
175
176 int
177 win32_connect(SOCKET s, const struct sockaddr *addr, int addrlen)
178 {
179     int r;
180
181     SOCKET_TEST_ERROR(r = connect(TO_SOCKET(s), addr, addrlen));
182     return r;
183 }
184
185
186 int
187 win32_getpeername(SOCKET s, struct sockaddr *addr, int *addrlen)
188 {
189     int r;
190
191     SOCKET_TEST_ERROR(r = getpeername(TO_SOCKET(s), addr, addrlen));
192     return r;
193 }
194
195 int
196 win32_getsockname(SOCKET s, struct sockaddr *addr, int *addrlen)
197 {
198     int r;
199
200     SOCKET_TEST_ERROR(r = getsockname(TO_SOCKET(s), addr, addrlen));
201     return r;
202 }
203
204 int
205 win32_getsockopt(SOCKET s, int level, int optname, char *optval, int *optlen)
206 {
207     int r;
208
209     SOCKET_TEST_ERROR(r = getsockopt(TO_SOCKET(s), level, optname, optval, optlen));
210     return r;
211 }
212
213 int
214 win32_ioctlsocket(SOCKET s, long cmd, u_long *argp)
215 {
216     int r;
217
218     SOCKET_TEST_ERROR(r = ioctlsocket(TO_SOCKET(s), cmd, argp));
219     return r;
220 }
221
222 int
223 win32_listen(SOCKET s, int backlog)
224 {
225     int r;
226
227     SOCKET_TEST_ERROR(r = listen(TO_SOCKET(s), backlog));
228     return r;
229 }
230
231 int
232 win32_recv(SOCKET s, char *buf, int len, int flags)
233 {
234     int r;
235
236     SOCKET_TEST_ERROR(r = recv(TO_SOCKET(s), buf, len, flags));
237     return r;
238 }
239
240 int
241 win32_recvfrom(SOCKET s, char *buf, int len, int flags, struct sockaddr *from, int *fromlen)
242 {
243     int r;
244     int frombufsize = *fromlen;
245
246     SOCKET_TEST_ERROR(r = recvfrom(TO_SOCKET(s), buf, len, flags, from, fromlen));
247     /* Winsock's recvfrom() only returns a valid 'from' when the socket
248      * is connectionless.  Perl expects a valid 'from' for all types
249      * of sockets, so go the extra mile.
250      */
251     if (r != SOCKET_ERROR && frombufsize == *fromlen)
252         (void)win32_getpeername(s, from, fromlen);
253     return r;
254 }
255
256 /* select contributed by Vincent R. Slyngstad (vrs@ibeam.intel.com) */
257 int
258 win32_select(int nfds, Perl_fd_set* rd, Perl_fd_set* wr, Perl_fd_set* ex, const struct timeval* timeout)
259 {
260     int r;
261 #ifdef USE_SOCKETS_AS_HANDLES
262     int i, fd, save_errno = errno;
263     FD_SET nrd, nwr, nex;
264     bool just_sleep = TRUE;
265
266     StartSockets();
267
268     FD_ZERO(&nrd);
269     FD_ZERO(&nwr);
270     FD_ZERO(&nex);
271     for (i = 0; i < nfds; i++) {
272         if (rd && PERL_FD_ISSET(i,rd)) {
273             fd = TO_SOCKET(i);
274             FD_SET((unsigned)fd, &nrd);
275             just_sleep = FALSE;
276         }
277         if (wr && PERL_FD_ISSET(i,wr)) {
278             fd = TO_SOCKET(i);
279             FD_SET((unsigned)fd, &nwr);
280             just_sleep = FALSE;
281         }
282         if (ex && PERL_FD_ISSET(i,ex)) {
283             fd = TO_SOCKET(i);
284             FD_SET((unsigned)fd, &nex);
285             just_sleep = FALSE;
286         }
287     }
288
289     /* winsock seems incapable of dealing with all three fd_sets being empty,
290      * so do the (millisecond) sleep as a special case
291      */
292     if (just_sleep) {
293         if (timeout)
294             Sleep(timeout->tv_sec  * 1000 +
295                   timeout->tv_usec / 1000);     /* do the best we can */
296         else
297             Sleep(UINT_MAX);
298         return 0;
299     }
300
301     errno = save_errno;
302     SOCKET_TEST_ERROR(r = select(nfds, &nrd, &nwr, &nex, timeout));
303     save_errno = errno;
304
305     for (i = 0; i < nfds; i++) {
306         if (rd && PERL_FD_ISSET(i,rd)) {
307             fd = TO_SOCKET(i);
308             if (!FD_ISSET(fd, &nrd))
309                 PERL_FD_CLR(i,rd);
310         }
311         if (wr && PERL_FD_ISSET(i,wr)) {
312             fd = TO_SOCKET(i);
313             if (!FD_ISSET(fd, &nwr))
314                 PERL_FD_CLR(i,wr);
315         }
316         if (ex && PERL_FD_ISSET(i,ex)) {
317             fd = TO_SOCKET(i);
318             if (!FD_ISSET(fd, &nex))
319                 PERL_FD_CLR(i,ex);
320         }
321     }
322     errno = save_errno;
323 #else
324     SOCKET_TEST_ERROR(r = select(nfds, rd, wr, ex, timeout));
325 #endif
326     return r;
327 }
328
329 int
330 win32_send(SOCKET s, const char *buf, int len, int flags)
331 {
332     int r;
333
334     SOCKET_TEST_ERROR(r = send(TO_SOCKET(s), buf, len, flags));
335     return r;
336 }
337
338 int
339 win32_sendto(SOCKET s, const char *buf, int len, int flags,
340              const struct sockaddr *to, int tolen)
341 {
342     int r;
343
344     SOCKET_TEST_ERROR(r = sendto(TO_SOCKET(s), buf, len, flags, to, tolen));
345     return r;
346 }
347
348 int
349 win32_setsockopt(SOCKET s, int level, int optname, const char *optval, int optlen)
350 {
351     int r;
352
353     SOCKET_TEST_ERROR(r = setsockopt(TO_SOCKET(s), level, optname, optval, optlen));
354     return r;
355 }
356     
357 int
358 win32_shutdown(SOCKET s, int how)
359 {
360     int r;
361
362     SOCKET_TEST_ERROR(r = shutdown(TO_SOCKET(s), how));
363     return r;
364 }
365
366 int
367 win32_closesocket(SOCKET s)
368 {
369     int r;
370
371     SOCKET_TEST_ERROR(r = closesocket(TO_SOCKET(s)));
372     return r;
373 }
374
375 #ifdef USE_SOCKETS_AS_HANDLES
376 #define WIN32_OPEN_SOCKET(af, type, protocol) open_ifs_socket(af, type, protocol)
377
378 void
379 convert_proto_info_w2a(WSAPROTOCOL_INFOW *in, WSAPROTOCOL_INFOA *out)
380 {
381     Copy(in, out, 1, WSAPROTOCOL_INFOA);
382     wcstombs(out->szProtocol, in->szProtocol, sizeof(out->szProtocol));
383 }
384
385 SOCKET
386 open_ifs_socket(int af, int type, int protocol)
387 {
388     dTHX;
389     char *s;
390     unsigned long proto_buffers_len = 0;
391     int error_code;
392     SOCKET out = INVALID_SOCKET;
393
394     if ((s = PerlEnv_getenv("PERL_ALLOW_NON_IFS_LSP")) && atoi(s))
395         return WSASocket(af, type, protocol, NULL, 0, 0);
396
397     if (WSCEnumProtocols(NULL, NULL, &proto_buffers_len, &error_code) == SOCKET_ERROR
398         && error_code == WSAENOBUFS)
399     {
400         WSAPROTOCOL_INFOW *proto_buffers;
401         int protocols_available = 0;       
402  
403         Newx(proto_buffers, proto_buffers_len / sizeof(WSAPROTOCOL_INFOW),
404             WSAPROTOCOL_INFOW);
405
406         if ((protocols_available = WSCEnumProtocols(NULL, proto_buffers, 
407             &proto_buffers_len, &error_code)) != SOCKET_ERROR)
408         {
409             int i;
410             for (i = 0; i < protocols_available; i++)
411             {
412                 WSAPROTOCOL_INFOA proto_info;
413
414                 if ((af != AF_UNSPEC && af != proto_buffers[i].iAddressFamily)
415                     || (type != proto_buffers[i].iSocketType)
416                     || (protocol != 0 && proto_buffers[i].iProtocol != 0 &&
417                         protocol != proto_buffers[i].iProtocol))
418                     continue;
419
420                 if ((proto_buffers[i].dwServiceFlags1 & XP1_IFS_HANDLES) == 0)
421                     continue;
422
423                 convert_proto_info_w2a(&(proto_buffers[i]), &proto_info);
424
425                 out = WSASocket(af, type, protocol, &proto_info, 0, 0);
426                 break;
427             }
428         }
429
430         Safefree(proto_buffers);
431     }
432
433     return out;
434 }
435
436 #else
437 #define WIN32_OPEN_SOCKET(af, type, protocol) socket(af, type, protocol)
438 #endif
439
440 SOCKET
441 win32_socket(int af, int type, int protocol)
442 {
443     SOCKET s;
444
445 #ifndef USE_SOCKETS_AS_HANDLES
446     SOCKET_TEST(s = socket(af, type, protocol), INVALID_SOCKET);
447 #else
448     StartSockets();
449
450     if((s = WIN32_OPEN_SOCKET(af, type, protocol)) == INVALID_SOCKET)
451         errno = WSAGetLastError();
452     else
453         s = OPEN_SOCKET(s);
454 #endif  /* USE_SOCKETS_AS_HANDLES */
455
456     return s;
457 }
458
459 /*
460  * close RTL fd while respecting sockets
461  * added as temporary measure until PerlIO has real
462  * Win32 native layer
463  *   -- BKS, 11-11-2000
464 */
465
466 int my_close(int fd)
467 {
468     int osf;
469     if (!wsock_started)         /* No WinSock? */
470         return(close(fd));      /* Then not a socket. */
471     osf = TO_SOCKET(fd);/* Get it now before it's gone! */
472     if (osf != -1) {
473         int err;
474         err = closesocket(osf);
475         if (err == 0) {
476             (void)close(fd);    /* handle already closed, ignore error */
477             return 0;
478         }
479         else if (err == SOCKET_ERROR) {
480             err = WSAGetLastError();
481             if (err != WSAENOTSOCK) {
482                 (void)close(fd);
483                 errno = err;
484                 return EOF;
485             }
486         }
487     }
488     return close(fd);
489 }
490
491 #undef fclose
492 int
493 my_fclose (FILE *pf)
494 {
495     int osf;
496     if (!wsock_started)         /* No WinSock? */
497         return(fclose(pf));     /* Then not a socket. */
498     osf = TO_SOCKET(win32_fileno(pf));/* Get it now before it's gone! */
499     if (osf != -1) {
500         int err;
501         win32_fflush(pf);
502         err = closesocket(osf);
503         if (err == 0) {
504             (void)fclose(pf);   /* handle already closed, ignore error */
505             return 0;
506         }
507         else if (err == SOCKET_ERROR) {
508             err = WSAGetLastError();
509             if (err != WSAENOTSOCK) {
510                 (void)fclose(pf);
511                 errno = err;
512                 return EOF;
513             }
514         }
515     }
516     return fclose(pf);
517 }
518
519 struct hostent *
520 win32_gethostbyaddr(const char *addr, int len, int type)
521 {
522     struct hostent *r;
523
524     SOCKET_TEST(r = gethostbyaddr(addr, len, type), NULL);
525     return r;
526 }
527
528 struct hostent *
529 win32_gethostbyname(const char *name)
530 {
531     struct hostent *r;
532
533     SOCKET_TEST(r = gethostbyname(name), NULL);
534     return r;
535 }
536
537 int
538 win32_gethostname(char *name, int len)
539 {
540     int r;
541
542     SOCKET_TEST_ERROR(r = gethostname(name, len));
543     return r;
544 }
545
546 struct protoent *
547 win32_getprotobyname(const char *name)
548 {
549     struct protoent *r;
550
551     SOCKET_TEST(r = getprotobyname(name), NULL);
552     return r;
553 }
554
555 struct protoent *
556 win32_getprotobynumber(int num)
557 {
558     struct protoent *r;
559
560     SOCKET_TEST(r = getprotobynumber(num), NULL);
561     return r;
562 }
563
564 struct servent *
565 win32_getservbyname(const char *name, const char *proto)
566 {
567     dTHX;    
568     struct servent *r;
569
570     SOCKET_TEST(r = getservbyname(name, proto), NULL);
571     if (r) {
572         r = win32_savecopyservent(&w32_servent, r, proto);
573     }
574     return r;
575 }
576
577 struct servent *
578 win32_getservbyport(int port, const char *proto)
579 {
580     dTHX; 
581     struct servent *r;
582
583     SOCKET_TEST(r = getservbyport(port, proto), NULL);
584     if (r) {
585         r = win32_savecopyservent(&w32_servent, r, proto);
586     }
587     return r;
588 }
589
590 int
591 win32_ioctl(int i, unsigned int u, char *data)
592 {
593     dTHX;
594     u_long u_long_arg; 
595     int retval;
596     
597     if (!wsock_started) {
598         Perl_croak_nocontext("ioctl implemented only on sockets");
599         /* NOTREACHED */
600     }
601
602     /* mauke says using memcpy avoids alignment issues */
603     memcpy(&u_long_arg, data, sizeof u_long_arg); 
604     retval = ioctlsocket(TO_SOCKET(i), (long)u, &u_long_arg);
605     memcpy(data, &u_long_arg, sizeof u_long_arg);
606     
607     if (retval == SOCKET_ERROR) {
608         if (WSAGetLastError() == WSAENOTSOCK) {
609             Perl_croak_nocontext("ioctl implemented only on sockets");
610             /* NOTREACHED */
611         }
612         errno = WSAGetLastError();
613     }
614     return retval;
615 }
616
617 char FAR *
618 win32_inet_ntoa(struct in_addr in)
619 {
620     StartSockets();
621     return inet_ntoa(in);
622 }
623
624 unsigned long
625 win32_inet_addr(const char FAR *cp)
626 {
627     StartSockets();
628     return inet_addr(cp);
629 }
630
631 /*
632  * Networking stubs
633  */
634
635 void
636 win32_endhostent() 
637 {
638     dTHX;
639     Perl_croak_nocontext("endhostent not implemented!\n");
640 }
641
642 void
643 win32_endnetent()
644 {
645     dTHX;
646     Perl_croak_nocontext("endnetent not implemented!\n");
647 }
648
649 void
650 win32_endprotoent()
651 {
652     dTHX;
653     Perl_croak_nocontext("endprotoent not implemented!\n");
654 }
655
656 void
657 win32_endservent()
658 {
659     dTHX;
660     Perl_croak_nocontext("endservent not implemented!\n");
661 }
662
663
664 struct netent *
665 win32_getnetent(void) 
666 {
667     dTHX;
668     Perl_croak_nocontext("getnetent not implemented!\n");
669     return (struct netent *) NULL;
670 }
671
672 struct netent *
673 win32_getnetbyname(char *name) 
674 {
675     dTHX;
676     Perl_croak_nocontext("getnetbyname not implemented!\n");
677     return (struct netent *)NULL;
678 }
679
680 struct netent *
681 win32_getnetbyaddr(long net, int type) 
682 {
683     dTHX;
684     Perl_croak_nocontext("getnetbyaddr not implemented!\n");
685     return (struct netent *)NULL;
686 }
687
688 struct protoent *
689 win32_getprotoent(void) 
690 {
691     dTHX;
692     Perl_croak_nocontext("getprotoent not implemented!\n");
693     return (struct protoent *) NULL;
694 }
695
696 struct servent *
697 win32_getservent(void) 
698 {
699     dTHX;
700     Perl_croak_nocontext("getservent not implemented!\n");
701     return (struct servent *) NULL;
702 }
703
704 void
705 win32_sethostent(int stayopen)
706 {
707     dTHX;
708     Perl_croak_nocontext("sethostent not implemented!\n");
709 }
710
711
712 void
713 win32_setnetent(int stayopen)
714 {
715     dTHX;
716     Perl_croak_nocontext("setnetent not implemented!\n");
717 }
718
719
720 void
721 win32_setprotoent(int stayopen)
722 {
723     dTHX;
724     Perl_croak_nocontext("setprotoent not implemented!\n");
725 }
726
727
728 void
729 win32_setservent(int stayopen)
730 {
731     dTHX;
732     Perl_croak_nocontext("setservent not implemented!\n");
733 }
734
735 static struct servent*
736 win32_savecopyservent(struct servent*d, struct servent*s, const char *proto)
737 {
738     d->s_name = s->s_name;
739     d->s_aliases = s->s_aliases;
740     d->s_port = s->s_port;
741 #ifndef __BORLANDC__    /* Buggy on WinNT-with-Borland-WSOCK */
742     if (s->s_proto && strlen(s->s_proto))
743         d->s_proto = s->s_proto;
744     else
745 #endif
746     if (proto && strlen(proto))
747         d->s_proto = (char *)proto;
748     else
749         d->s_proto = "tcp";
750    
751     return d;
752 }
753
754