Support one-parameter unpack(), which unpacks $_.
[perl.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_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_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_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;
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, Stat_t *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 #if defined(WIN64) || defined(USE_LARGE_FILES)
497         return _fstati64(fd, sbufptr);
498 #else
499         return fstat(fd, sbufptr);
500 #endif
501     }
502
503     osf = TO_SOCKET(fd);
504     if (osf != -1) {
505         char sockbuf[256];
506         int optlen = sizeof(sockbuf);
507         int retval;
508
509         retval = getsockopt((SOCKET)osf, SOL_SOCKET, SO_TYPE, sockbuf, &optlen);
510         if (retval != SOCKET_ERROR || WSAGetLastError() != WSAENOTSOCK) {
511 #if defined(__BORLANDC__)&&(__BORLANDC__<=0x520)
512             sbufptr->st_mode = S_IFIFO;
513 #else
514             sbufptr->st_mode = _S_IFIFO;
515 #endif
516             sbufptr->st_rdev = sbufptr->st_dev = (dev_t)fd;
517             sbufptr->st_nlink = 1;
518             sbufptr->st_uid = sbufptr->st_gid = sbufptr->st_ino = 0;
519             sbufptr->st_atime = sbufptr->st_mtime = sbufptr->st_ctime = 0;
520             sbufptr->st_size = (Off_t)0;
521             return 0;
522         }
523     }
524 #if defined(WIN64) || defined(USE_LARGE_FILES)
525     return _fstati64(fd, sbufptr);
526 #else
527     return fstat(fd, sbufptr);
528 #endif
529 }
530
531 struct hostent *
532 win32_gethostbyaddr(const char *addr, int len, int type)
533 {
534     struct hostent *r;
535
536     SOCKET_TEST(r = gethostbyaddr(addr, len, type), NULL);
537     return r;
538 }
539
540 struct hostent *
541 win32_gethostbyname(const char *name)
542 {
543     struct hostent *r;
544
545     SOCKET_TEST(r = gethostbyname(name), NULL);
546     return r;
547 }
548
549 int
550 win32_gethostname(char *name, int len)
551 {
552     int r;
553
554     SOCKET_TEST_ERROR(r = gethostname(name, len));
555     return r;
556 }
557
558 struct protoent *
559 win32_getprotobyname(const char *name)
560 {
561     struct protoent *r;
562
563     SOCKET_TEST(r = getprotobyname(name), NULL);
564     return r;
565 }
566
567 struct protoent *
568 win32_getprotobynumber(int num)
569 {
570     struct protoent *r;
571
572     SOCKET_TEST(r = getprotobynumber(num), NULL);
573     return r;
574 }
575
576 struct servent *
577 win32_getservbyname(const char *name, const char *proto)
578 {
579     dTHX;    
580     struct servent *r;
581
582     SOCKET_TEST(r = getservbyname(name, proto), NULL);
583     if (r) {
584         r = win32_savecopyservent(&w32_servent, r, proto);
585     }
586     return r;
587 }
588
589 struct servent *
590 win32_getservbyport(int port, const char *proto)
591 {
592     dTHX; 
593     struct servent *r;
594
595     SOCKET_TEST(r = getservbyport(port, proto), NULL);
596     if (r) {
597         r = win32_savecopyservent(&w32_servent, r, proto);
598     }
599     return r;
600 }
601
602 int
603 win32_ioctl(int i, unsigned int u, char *data)
604 {
605     dTHX;
606     u_long argp = (u_long)data;
607     int retval;
608
609     if (!wsock_started) {
610         Perl_croak_nocontext("ioctl implemented only on sockets");
611         /* NOTREACHED */
612     }
613
614     retval = ioctlsocket(TO_SOCKET(i), (long)u, &argp);
615     if (retval == SOCKET_ERROR) {
616         if (WSAGetLastError() == WSAENOTSOCK) {
617             Perl_croak_nocontext("ioctl implemented only on sockets");
618             /* NOTREACHED */
619         }
620         errno = WSAGetLastError();
621     }
622     return retval;
623 }
624
625 char FAR *
626 win32_inet_ntoa(struct in_addr in)
627 {
628     StartSockets();
629     return inet_ntoa(in);
630 }
631
632 unsigned long
633 win32_inet_addr(const char FAR *cp)
634 {
635     StartSockets();
636     return inet_addr(cp);
637 }
638
639 /*
640  * Networking stubs
641  */
642
643 void
644 win32_endhostent() 
645 {
646     dTHX;
647     Perl_croak_nocontext("endhostent not implemented!\n");
648 }
649
650 void
651 win32_endnetent()
652 {
653     dTHX;
654     Perl_croak_nocontext("endnetent not implemented!\n");
655 }
656
657 void
658 win32_endprotoent()
659 {
660     dTHX;
661     Perl_croak_nocontext("endprotoent not implemented!\n");
662 }
663
664 void
665 win32_endservent()
666 {
667     dTHX;
668     Perl_croak_nocontext("endservent not implemented!\n");
669 }
670
671
672 struct netent *
673 win32_getnetent(void) 
674 {
675     dTHX;
676     Perl_croak_nocontext("getnetent not implemented!\n");
677     return (struct netent *) NULL;
678 }
679
680 struct netent *
681 win32_getnetbyname(char *name) 
682 {
683     dTHX;
684     Perl_croak_nocontext("getnetbyname not implemented!\n");
685     return (struct netent *)NULL;
686 }
687
688 struct netent *
689 win32_getnetbyaddr(long net, int type) 
690 {
691     dTHX;
692     Perl_croak_nocontext("getnetbyaddr not implemented!\n");
693     return (struct netent *)NULL;
694 }
695
696 struct protoent *
697 win32_getprotoent(void) 
698 {
699     dTHX;
700     Perl_croak_nocontext("getprotoent not implemented!\n");
701     return (struct protoent *) NULL;
702 }
703
704 struct servent *
705 win32_getservent(void) 
706 {
707     dTHX;
708     Perl_croak_nocontext("getservent not implemented!\n");
709     return (struct servent *) NULL;
710 }
711
712 void
713 win32_sethostent(int stayopen)
714 {
715     dTHX;
716     Perl_croak_nocontext("sethostent not implemented!\n");
717 }
718
719
720 void
721 win32_setnetent(int stayopen)
722 {
723     dTHX;
724     Perl_croak_nocontext("setnetent not implemented!\n");
725 }
726
727
728 void
729 win32_setprotoent(int stayopen)
730 {
731     dTHX;
732     Perl_croak_nocontext("setprotoent not implemented!\n");
733 }
734
735
736 void
737 win32_setservent(int stayopen)
738 {
739     dTHX;
740     Perl_croak_nocontext("setservent not implemented!\n");
741 }
742
743 static struct servent*
744 win32_savecopyservent(struct servent*d, struct servent*s, const char *proto)
745 {
746     d->s_name = s->s_name;
747     d->s_aliases = s->s_aliases;
748     d->s_port = s->s_port;
749 #ifndef __BORLANDC__    /* Buggy on Win95 and WinNT-with-Borland-WSOCK */
750     if (!IsWin95() && s->s_proto && strlen(s->s_proto))
751         d->s_proto = s->s_proto;
752     else
753 #endif
754     if (proto && strlen(proto))
755         d->s_proto = (char *)proto;
756     else
757         d->s_proto = "tcp";
758    
759     return d;
760 }
761
762