Following b0e687f7 Win32 requires an -I..\lib for makedef.pl and x2p\*.PL
[perl.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
265     /* winsock seems incapable of dealing with all three null fd_sets,
266      * so do the (millisecond) sleep as a special case
267      */
268     if (!(rd || wr || ex)) {
269         if (timeout)
270             Sleep(timeout->tv_sec  * 1000 +
271                   timeout->tv_usec / 1000);     /* do the best we can */
272         else
273             Sleep(UINT_MAX);
274         return 0;
275     }
276     StartSockets();
277
278     FD_ZERO(&nrd);
279     FD_ZERO(&nwr);
280     FD_ZERO(&nex);
281     for (i = 0; i < nfds; i++) {
282         if (rd && PERL_FD_ISSET(i,rd)) {
283             fd = TO_SOCKET(i);
284             FD_SET((unsigned)fd, &nrd);
285         }
286         if (wr && PERL_FD_ISSET(i,wr)) {
287             fd = TO_SOCKET(i);
288             FD_SET((unsigned)fd, &nwr);
289         }
290         if (ex && PERL_FD_ISSET(i,ex)) {
291             fd = TO_SOCKET(i);
292             FD_SET((unsigned)fd, &nex);
293         }
294     }
295
296     errno = save_errno;
297     SOCKET_TEST_ERROR(r = select(nfds, &nrd, &nwr, &nex, timeout));
298     save_errno = errno;
299
300     for (i = 0; i < nfds; i++) {
301         if (rd && PERL_FD_ISSET(i,rd)) {
302             fd = TO_SOCKET(i);
303             if (!FD_ISSET(fd, &nrd))
304                 PERL_FD_CLR(i,rd);
305         }
306         if (wr && PERL_FD_ISSET(i,wr)) {
307             fd = TO_SOCKET(i);
308             if (!FD_ISSET(fd, &nwr))
309                 PERL_FD_CLR(i,wr);
310         }
311         if (ex && PERL_FD_ISSET(i,ex)) {
312             fd = TO_SOCKET(i);
313             if (!FD_ISSET(fd, &nex))
314                 PERL_FD_CLR(i,ex);
315         }
316     }
317     errno = save_errno;
318 #else
319     SOCKET_TEST_ERROR(r = select(nfds, rd, wr, ex, timeout));
320 #endif
321     return r;
322 }
323
324 int
325 win32_send(SOCKET s, const char *buf, int len, int flags)
326 {
327     int r;
328
329     SOCKET_TEST_ERROR(r = send(TO_SOCKET(s), buf, len, flags));
330     return r;
331 }
332
333 int
334 win32_sendto(SOCKET s, const char *buf, int len, int flags,
335              const struct sockaddr *to, int tolen)
336 {
337     int r;
338
339     SOCKET_TEST_ERROR(r = sendto(TO_SOCKET(s), buf, len, flags, to, tolen));
340     return r;
341 }
342
343 int
344 win32_setsockopt(SOCKET s, int level, int optname, const char *optval, int optlen)
345 {
346     int r;
347
348     SOCKET_TEST_ERROR(r = setsockopt(TO_SOCKET(s), level, optname, optval, optlen));
349     return r;
350 }
351     
352 int
353 win32_shutdown(SOCKET s, int how)
354 {
355     int r;
356
357     SOCKET_TEST_ERROR(r = shutdown(TO_SOCKET(s), how));
358     return r;
359 }
360
361 int
362 win32_closesocket(SOCKET s)
363 {
364     int r;
365
366     SOCKET_TEST_ERROR(r = closesocket(TO_SOCKET(s)));
367     return r;
368 }
369
370 #ifdef USE_SOCKETS_AS_HANDLES
371 #define WIN32_OPEN_SOCKET(af, type, protocol) open_ifs_socket(af, type, protocol)
372
373 void
374 convert_proto_info_w2a(WSAPROTOCOL_INFOW *in, WSAPROTOCOL_INFOA *out)
375 {
376     Copy(in, out, 1, WSAPROTOCOL_INFOA);
377     wcstombs(out->szProtocol, in->szProtocol, sizeof(out->szProtocol));
378 }
379
380 SOCKET
381 open_ifs_socket(int af, int type, int protocol)
382 {
383     dTHX;
384     char *s;
385     unsigned long proto_buffers_len = 0;
386     int error_code;
387     SOCKET out = INVALID_SOCKET;
388
389     if ((s = PerlEnv_getenv("PERL_ALLOW_NON_IFS_LSP")) && atoi(s))
390         return WSASocket(af, type, protocol, NULL, 0, 0);
391
392     if (WSCEnumProtocols(NULL, NULL, &proto_buffers_len, &error_code) == SOCKET_ERROR
393         && error_code == WSAENOBUFS)
394     {
395         WSAPROTOCOL_INFOW *proto_buffers;
396         int protocols_available = 0;       
397  
398         Newx(proto_buffers, proto_buffers_len / sizeof(WSAPROTOCOL_INFOW),
399             WSAPROTOCOL_INFOW);
400
401         if ((protocols_available = WSCEnumProtocols(NULL, proto_buffers, 
402             &proto_buffers_len, &error_code)) != SOCKET_ERROR)
403         {
404             int i;
405             for (i = 0; i < protocols_available; i++)
406             {
407                 WSAPROTOCOL_INFOA proto_info;
408
409                 if ((af != AF_UNSPEC && af != proto_buffers[i].iAddressFamily)
410                     || (type != proto_buffers[i].iSocketType)
411                     || (protocol != 0 && proto_buffers[i].iProtocol != 0 &&
412                         protocol != proto_buffers[i].iProtocol))
413                     continue;
414
415                 if ((proto_buffers[i].dwServiceFlags1 & XP1_IFS_HANDLES) == 0)
416                     continue;
417
418                 convert_proto_info_w2a(&(proto_buffers[i]), &proto_info);
419
420                 out = WSASocket(af, type, protocol, &proto_info, 0, 0);
421                 break;
422             }
423         }
424
425         Safefree(proto_buffers);
426     }
427
428     return out;
429 }
430
431 #else
432 #define WIN32_OPEN_SOCKET(af, type, protocol) socket(af, type, protocol)
433 #endif
434
435 SOCKET
436 win32_socket(int af, int type, int protocol)
437 {
438     SOCKET s;
439
440 #ifndef USE_SOCKETS_AS_HANDLES
441     SOCKET_TEST(s = socket(af, type, protocol), INVALID_SOCKET);
442 #else
443     StartSockets();
444
445     if((s = WIN32_OPEN_SOCKET(af, type, protocol)) == INVALID_SOCKET)
446         errno = WSAGetLastError();
447     else
448         s = OPEN_SOCKET(s);
449 #endif  /* USE_SOCKETS_AS_HANDLES */
450
451     return s;
452 }
453
454 /*
455  * close RTL fd while respecting sockets
456  * added as temporary measure until PerlIO has real
457  * Win32 native layer
458  *   -- BKS, 11-11-2000
459 */
460
461 int my_close(int fd)
462 {
463     int osf;
464     if (!wsock_started)         /* No WinSock? */
465         return(close(fd));      /* Then not a socket. */
466     osf = TO_SOCKET(fd);/* Get it now before it's gone! */
467     if (osf != -1) {
468         int err;
469         err = closesocket(osf);
470         if (err == 0) {
471 #if defined(USE_FIXED_OSFHANDLE) || defined(PERL_MSVCRT_READFIX)
472             _set_osfhnd(fd, INVALID_HANDLE_VALUE);
473 #endif
474             (void)close(fd);    /* handle already closed, ignore error */
475             return 0;
476         }
477         else if (err == SOCKET_ERROR) {
478             err = WSAGetLastError();
479             if (err != WSAENOTSOCK) {
480                 (void)close(fd);
481                 errno = err;
482                 return EOF;
483             }
484         }
485     }
486     return close(fd);
487 }
488
489 #undef fclose
490 int
491 my_fclose (FILE *pf)
492 {
493     int osf;
494     if (!wsock_started)         /* No WinSock? */
495         return(fclose(pf));     /* Then not a socket. */
496     osf = TO_SOCKET(win32_fileno(pf));/* Get it now before it's gone! */
497     if (osf != -1) {
498         int err;
499         win32_fflush(pf);
500         err = closesocket(osf);
501         if (err == 0) {
502 #if defined(USE_FIXED_OSFHANDLE) || defined(PERL_MSVCRT_READFIX)
503             _set_osfhnd(win32_fileno(pf), INVALID_HANDLE_VALUE);
504 #endif
505             (void)fclose(pf);   /* handle already closed, ignore error */
506             return 0;
507         }
508         else if (err == SOCKET_ERROR) {
509             err = WSAGetLastError();
510             if (err != WSAENOTSOCK) {
511                 (void)fclose(pf);
512                 errno = err;
513                 return EOF;
514             }
515         }
516     }
517     return fclose(pf);
518 }
519
520 #undef fstat
521 int
522 my_fstat(int fd, Stat_t *sbufptr)
523 {
524     /* This fixes a bug in fstat() on Windows 9x.  fstat() uses the
525      * GetFileType() win32 syscall, which will fail on Windows 9x.
526      * So if we recognize a socket on Windows 9x, we return the
527      * same results as on Windows NT/2000.
528      * XXX this should be extended further to set S_IFSOCK on
529      * sbufptr->st_mode.
530      */
531     int osf;
532     if (!wsock_started || IsWinNT()) {
533 #if defined(WIN64) || defined(USE_LARGE_FILES)
534 #if defined(__BORLANDC__) /* buk */
535         return win32_fstat(fd, sbufptr );
536 #else
537         return _fstati64(fd, sbufptr);
538 #endif
539 #else
540         return fstat(fd, sbufptr);
541 #endif
542     }
543
544     osf = TO_SOCKET(fd);
545     if (osf != -1) {
546         char sockbuf[256];
547         int optlen = sizeof(sockbuf);
548         int retval;
549
550         retval = getsockopt((SOCKET)osf, SOL_SOCKET, SO_TYPE, sockbuf, &optlen);
551         if (retval != SOCKET_ERROR || WSAGetLastError() != WSAENOTSOCK) {
552 #if defined(__BORLANDC__)&&(__BORLANDC__<=0x520)
553             sbufptr->st_mode = S_IFIFO;
554 #else
555             sbufptr->st_mode = _S_IFIFO;
556 #endif
557             sbufptr->st_rdev = sbufptr->st_dev = (dev_t)fd;
558             sbufptr->st_nlink = 1;
559             sbufptr->st_uid = sbufptr->st_gid = sbufptr->st_ino = 0;
560             sbufptr->st_atime = sbufptr->st_mtime = sbufptr->st_ctime = 0;
561             sbufptr->st_size = (Off_t)0;
562             return 0;
563         }
564     }
565 #if defined(WIN64) || defined(USE_LARGE_FILES)
566 #if defined(__BORLANDC__) /* buk */
567     return win32_fstat(fd, sbufptr );
568 #else
569     return _fstati64(fd, sbufptr);
570 #endif
571 #else
572     return fstat(fd, sbufptr);
573 #endif
574 }
575
576 struct hostent *
577 win32_gethostbyaddr(const char *addr, int len, int type)
578 {
579     struct hostent *r;
580
581     SOCKET_TEST(r = gethostbyaddr(addr, len, type), NULL);
582     return r;
583 }
584
585 struct hostent *
586 win32_gethostbyname(const char *name)
587 {
588     struct hostent *r;
589
590     SOCKET_TEST(r = gethostbyname(name), NULL);
591     return r;
592 }
593
594 int
595 win32_gethostname(char *name, int len)
596 {
597     int r;
598
599     SOCKET_TEST_ERROR(r = gethostname(name, len));
600     return r;
601 }
602
603 struct protoent *
604 win32_getprotobyname(const char *name)
605 {
606     struct protoent *r;
607
608     SOCKET_TEST(r = getprotobyname(name), NULL);
609     return r;
610 }
611
612 struct protoent *
613 win32_getprotobynumber(int num)
614 {
615     struct protoent *r;
616
617     SOCKET_TEST(r = getprotobynumber(num), NULL);
618     return r;
619 }
620
621 struct servent *
622 win32_getservbyname(const char *name, const char *proto)
623 {
624     dTHX;    
625     struct servent *r;
626
627     SOCKET_TEST(r = getservbyname(name, proto), NULL);
628     if (r) {
629         r = win32_savecopyservent(&w32_servent, r, proto);
630     }
631     return r;
632 }
633
634 struct servent *
635 win32_getservbyport(int port, const char *proto)
636 {
637     dTHX; 
638     struct servent *r;
639
640     SOCKET_TEST(r = getservbyport(port, proto), NULL);
641     if (r) {
642         r = win32_savecopyservent(&w32_servent, r, proto);
643     }
644     return r;
645 }
646
647 int
648 win32_ioctl(int i, unsigned int u, char *data)
649 {
650     dTHX;
651     u_long u_long_arg; 
652     int retval;
653     
654     if (!wsock_started) {
655         Perl_croak_nocontext("ioctl implemented only on sockets");
656         /* NOTREACHED */
657     }
658
659     /* mauke says using memcpy avoids alignment issues */
660     memcpy(&u_long_arg, data, sizeof u_long_arg); 
661     retval = ioctlsocket(TO_SOCKET(i), (long)u, &u_long_arg);
662     memcpy(data, &u_long_arg, sizeof u_long_arg);
663     
664     if (retval == SOCKET_ERROR) {
665         if (WSAGetLastError() == WSAENOTSOCK) {
666             Perl_croak_nocontext("ioctl implemented only on sockets");
667             /* NOTREACHED */
668         }
669         errno = WSAGetLastError();
670     }
671     return retval;
672 }
673
674 char FAR *
675 win32_inet_ntoa(struct in_addr in)
676 {
677     StartSockets();
678     return inet_ntoa(in);
679 }
680
681 unsigned long
682 win32_inet_addr(const char FAR *cp)
683 {
684     StartSockets();
685     return inet_addr(cp);
686 }
687
688 /*
689  * Networking stubs
690  */
691
692 void
693 win32_endhostent() 
694 {
695     dTHX;
696     Perl_croak_nocontext("endhostent not implemented!\n");
697 }
698
699 void
700 win32_endnetent()
701 {
702     dTHX;
703     Perl_croak_nocontext("endnetent not implemented!\n");
704 }
705
706 void
707 win32_endprotoent()
708 {
709     dTHX;
710     Perl_croak_nocontext("endprotoent not implemented!\n");
711 }
712
713 void
714 win32_endservent()
715 {
716     dTHX;
717     Perl_croak_nocontext("endservent not implemented!\n");
718 }
719
720
721 struct netent *
722 win32_getnetent(void) 
723 {
724     dTHX;
725     Perl_croak_nocontext("getnetent not implemented!\n");
726     return (struct netent *) NULL;
727 }
728
729 struct netent *
730 win32_getnetbyname(char *name) 
731 {
732     dTHX;
733     Perl_croak_nocontext("getnetbyname not implemented!\n");
734     return (struct netent *)NULL;
735 }
736
737 struct netent *
738 win32_getnetbyaddr(long net, int type) 
739 {
740     dTHX;
741     Perl_croak_nocontext("getnetbyaddr not implemented!\n");
742     return (struct netent *)NULL;
743 }
744
745 struct protoent *
746 win32_getprotoent(void) 
747 {
748     dTHX;
749     Perl_croak_nocontext("getprotoent not implemented!\n");
750     return (struct protoent *) NULL;
751 }
752
753 struct servent *
754 win32_getservent(void) 
755 {
756     dTHX;
757     Perl_croak_nocontext("getservent not implemented!\n");
758     return (struct servent *) NULL;
759 }
760
761 void
762 win32_sethostent(int stayopen)
763 {
764     dTHX;
765     Perl_croak_nocontext("sethostent not implemented!\n");
766 }
767
768
769 void
770 win32_setnetent(int stayopen)
771 {
772     dTHX;
773     Perl_croak_nocontext("setnetent not implemented!\n");
774 }
775
776
777 void
778 win32_setprotoent(int stayopen)
779 {
780     dTHX;
781     Perl_croak_nocontext("setprotoent not implemented!\n");
782 }
783
784
785 void
786 win32_setservent(int stayopen)
787 {
788     dTHX;
789     Perl_croak_nocontext("setservent not implemented!\n");
790 }
791
792 static struct servent*
793 win32_savecopyservent(struct servent*d, struct servent*s, const char *proto)
794 {
795     d->s_name = s->s_name;
796     d->s_aliases = s->s_aliases;
797     d->s_port = s->s_port;
798 #ifndef __BORLANDC__    /* Buggy on Win95 and WinNT-with-Borland-WSOCK */
799     if (!IsWin95() && s->s_proto && strlen(s->s_proto))
800         d->s_proto = s->s_proto;
801     else
802 #endif
803     if (proto && strlen(proto))
804         d->s_proto = (char *)proto;
805     else
806         d->s_proto = "tcp";
807    
808     return d;
809 }
810
811