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