Use __declspec(thread) var rather tha TslAlloc & co.
[p5sagit/p5-mst-13.2.git] / win32 / win32.c
1 /* WIN32.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 WIN32_LEAN_AND_MEAN
12 #define WIN32IO_IS_STDIO
13 #include <tchar.h>
14 #include <windows.h>
15
16 /* #include "config.h" */
17
18 #define PERLIO_NOT_STDIO 0 
19 #if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
20 #define PerlIO FILE
21 #endif
22
23 #include "EXTERN.h"
24 #include "perl.h"
25 #include "XSUB.h"
26 #include <fcntl.h>
27 #include <sys/stat.h>
28 #include <assert.h>
29 #include <string.h>
30 #include <stdarg.h>
31 #include <float.h>
32
33 #define EXECF_EXEC 1
34 #define EXECF_SPAWN 2
35 #define EXECF_SPAWN_NOWAIT 3
36
37 static DWORD IdOS(void);
38
39 BOOL  ProbeEnv = FALSE;
40 DWORD Win32System = (DWORD)-1;
41 char  szShellPath[MAX_PATH+1];
42 char  szPerlLibRoot[MAX_PATH+1];
43 HANDLE PerlDllHandle = INVALID_HANDLE_VALUE;
44
45 static int do_spawn2(char *cmd, int exectype);
46
47 int 
48 IsWin95(void) {
49     return (IdOS() == VER_PLATFORM_WIN32_WINDOWS);
50 }
51
52 int
53 IsWinNT(void) {
54     return (IdOS() == VER_PLATFORM_WIN32_NT);
55 }
56
57 char *
58 win32PerlLibPath(void)
59 {
60     char *end;
61     GetModuleFileName((PerlDllHandle == INVALID_HANDLE_VALUE) 
62                       ? GetModuleHandle(NULL)
63                       : PerlDllHandle,
64                       szPerlLibRoot, 
65                       sizeof(szPerlLibRoot));
66
67     *(end = strrchr(szPerlLibRoot, '\\')) = '\0';
68     if (stricmp(end-4,"\\bin") == 0)
69      end -= 4;
70     strcpy(end,"\\lib");
71     return (szPerlLibRoot);
72 }
73
74 char *
75 win32SiteLibPath(void)
76 {
77     static char szPerlSiteLib[MAX_PATH+1];
78     strcpy(szPerlSiteLib, win32PerlLibPath());
79     strcat(szPerlSiteLib, "\\site");
80     return (szPerlSiteLib);
81 }
82
83 BOOL
84 HasRedirection(char *ptr)
85 {
86     int inquote = 0;
87     char quote = '\0';
88
89     /*
90      * Scan string looking for redirection (< or >) or pipe
91      * characters (|) that are not in a quoted string
92      */
93     while(*ptr) {
94         switch(*ptr) {
95         case '\'':
96         case '\"':
97             if(inquote) {
98                 if(quote == *ptr) {
99                     inquote = 0;
100                     quote = '\0';
101                 }
102             }
103             else {
104                 quote = *ptr;
105                 inquote++;
106             }
107             break;
108         case '>':
109         case '<':
110         case '|':
111             if(!inquote)
112                 return TRUE;
113         default:
114             break;
115         }
116         ++ptr;
117     }
118     return FALSE;
119 }
120
121 /* since the current process environment is being updated in util.c
122  * the library functions will get the correct environment
123  */
124 PerlIO *
125 my_popen(char *cmd, char *mode)
126 {
127 #ifdef FIXCMD
128 #define fixcmd(x)       {                                       \
129                             char *pspace = strchr((x),' ');     \
130                             if (pspace) {                       \
131                                 char *p = (x);                  \
132                                 while (p < pspace) {            \
133                                     if (*p == '/')              \
134                                         *p = '\\';              \
135                                     p++;                        \
136                                 }                               \
137                             }                                   \
138                         }
139 #else
140 #define fixcmd(x)
141 #endif
142     fixcmd(cmd);
143 #ifdef __BORLANDC__ /* workaround a Borland stdio bug */
144     win32_fflush(stdout);
145     win32_fflush(stderr);
146 #endif
147     return win32_popen(cmd, mode);
148 }
149
150 long
151 my_pclose(PerlIO *fp)
152 {
153     return win32_pclose(fp);
154 }
155
156 static DWORD
157 IdOS(void)
158 {
159     static OSVERSIONINFO osver;
160
161     if (osver.dwPlatformId != Win32System) {
162         memset(&osver, 0, sizeof(OSVERSIONINFO));
163         osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
164         GetVersionEx(&osver);
165         Win32System = osver.dwPlatformId;
166     }
167     return (Win32System);
168 }
169
170 static char *
171 GetShell(void)
172 {
173     if (!ProbeEnv) {
174         char* defaultshell = (IsWinNT() ? "cmd.exe" : "command.com");
175         /* we don't use COMSPEC here for two reasons:
176          *  1. the same reason perl on UNIX doesn't use SHELL--rampant and
177          *     uncontrolled unportability of the ensuing scripts.
178          *  2. PERL5SHELL could be set to a shell that may not be fit for
179          *     interactive use (which is what most programs look in COMSPEC
180          *     for).
181          */
182         char *usershell = getenv("PERL5SHELL");  
183
184         ProbeEnv = TRUE;
185         strcpy(szShellPath, usershell ? usershell : defaultshell);
186     }
187     return szShellPath;
188 }
189
190 int
191 do_aspawn(void* really, void ** mark, void ** arglast)
192 {
193     char **argv;
194     char *strPtr;
195     char *cmd;
196     int status;
197     unsigned int length;
198     int index = 0;
199     SV *sv = (SV*)really;
200     SV** pSv = (SV**)mark;
201
202     New(1310, argv, (arglast - mark) + 4, char*);
203
204     if(sv != Nullsv) {
205         cmd = SvPV(sv, length);
206     }
207     else {
208         argv[index++] = cmd = GetShell();
209         if (IsWinNT())
210             argv[index++] = "/x";   /* always enable command extensions */
211         argv[index++] = "/c";
212     }
213
214     while(++pSv <= (SV**)arglast) {
215         sv = *pSv;
216         strPtr = SvPV(sv, length);
217         if(strPtr != NULL && *strPtr != '\0')
218             argv[index++] = strPtr;
219     }
220     argv[index++] = 0;
221    
222     status = win32_spawnvp(P_WAIT, cmd, (const char* const*)argv);
223
224     Safefree(argv);
225
226     if (status < 0) {
227         if (dowarn)
228             warn("Can't spawn \"%s\": %s", cmd, strerror(errno));
229         status = 255 << 8;
230     }
231     return (status);
232 }
233
234 int
235 do_spawn2(char *cmd, int exectype)
236 {
237     char **a;
238     char *s;
239     char **argv;
240     int status = -1;
241     BOOL needToTry = TRUE;
242     char *shell, *cmd2;
243
244     /* save an extra exec if possible */
245     shell = GetShell();
246
247     /* see if there are shell metacharacters in it */
248     if(!HasRedirection(cmd)) {
249         New(1301,argv, strlen(cmd) / 2 + 2, char*);
250         New(1302,cmd2, strlen(cmd) + 1, char);
251         strcpy(cmd2, cmd);
252         a = argv;
253         for (s = cmd2; *s;) {
254             while (*s && isspace(*s))
255                 s++;
256             if (*s)
257                 *(a++) = s;
258             while(*s && !isspace(*s))
259                 s++;
260             if(*s)
261                 *s++ = '\0';
262         }
263         *a = Nullch;
264         if(argv[0]) {
265             switch (exectype) {
266             case EXECF_SPAWN:
267                 status = win32_spawnvp(P_WAIT, argv[0],
268                                        (const char* const*)argv);
269                 break;
270             case EXECF_SPAWN_NOWAIT:
271                 status = win32_spawnvp(P_NOWAIT, argv[0],
272                                        (const char* const*)argv);
273                 break;
274             case EXECF_EXEC:
275                 status = win32_execvp(argv[0], (const char* const*)argv);
276                 break;
277             }
278             if(status != -1 || errno == 0)
279                 needToTry = FALSE;
280         }
281         Safefree(argv);
282         Safefree(cmd2);
283     }
284     if(needToTry) {
285         char *argv[5];
286         int i = 0;
287         argv[i++] = shell;
288         if (IsWinNT())
289             argv[i++] = "/x";
290         argv[i++] = "/c"; argv[i++] = cmd; argv[i] = Nullch;
291         switch (exectype) {
292         case EXECF_SPAWN:
293             status = win32_spawnvp(P_WAIT, argv[0],
294                                    (const char* const*)argv);
295             break;
296         case EXECF_SPAWN_NOWAIT:
297             status = win32_spawnvp(P_NOWAIT, argv[0],
298                                    (const char* const*)argv);
299             break;
300         case EXECF_EXEC:
301             status = win32_execvp(argv[0], (const char* const*)argv);
302             break;
303         }
304     }
305     if (status < 0) {
306         if (dowarn)
307             warn("Can't %s \"%s\": %s",
308                  (exectype == EXECF_EXEC ? "exec" : "spawn"),
309                  needToTry ? shell : argv[0],
310                  strerror(errno));
311         status = 255 << 8;
312     }
313     return (status);
314 }
315
316 int
317 do_spawn(char *cmd)
318 {
319     return do_spawn2(cmd, EXECF_SPAWN);
320 }
321
322 bool
323 do_exec(char *cmd)
324 {
325     do_spawn2(cmd, EXECF_EXEC);
326     return FALSE;
327 }
328
329
330 #define PATHLEN 1024
331
332 /* The idea here is to read all the directory names into a string table
333  * (separated by nulls) and when one of the other dir functions is called
334  * return the pointer to the current file name.
335  */
336 DIR *
337 opendir(char *filename)
338 {
339     DIR            *p;
340     long            len;
341     long            idx;
342     char            scannamespc[PATHLEN];
343     char       *scanname = scannamespc;
344     struct stat     sbuf;
345     WIN32_FIND_DATA FindData;
346     HANDLE          fh;
347 /*  char            root[_MAX_PATH];*/
348 /*  char            volname[_MAX_PATH];*/
349 /*  DWORD           serial, maxname, flags;*/
350 /*  BOOL            downcase;*/
351 /*  char           *dummy;*/
352
353     /* check to see if filename is a directory */
354     if (win32_stat(filename, &sbuf) < 0 || (sbuf.st_mode & S_IFDIR) == 0) {
355         return NULL;
356     }
357
358     /* get the file system characteristics */
359 /*  if(GetFullPathName(filename, MAX_PATH, root, &dummy)) {
360  *      if(dummy = strchr(root, '\\'))
361  *          *++dummy = '\0';
362  *      if(GetVolumeInformation(root, volname, MAX_PATH, &serial,
363  *                              &maxname, &flags, 0, 0)) {
364  *          downcase = !(flags & FS_CASE_IS_PRESERVED);
365  *      }
366  *  }
367  *  else {
368  *      downcase = TRUE;
369  *  }
370  */
371     /* Get us a DIR structure */
372     Newz(1303, p, 1, DIR);
373     if(p == NULL)
374         return NULL;
375
376     /* Create the search pattern */
377     strcpy(scanname, filename);
378
379     if(index("/\\", *(scanname + strlen(scanname) - 1)) == NULL)
380         strcat(scanname, "/*");
381     else
382         strcat(scanname, "*");
383
384     /* do the FindFirstFile call */
385     fh = FindFirstFile(scanname, &FindData);
386     if(fh == INVALID_HANDLE_VALUE) {
387         return NULL;
388     }
389
390     /* now allocate the first part of the string table for
391      * the filenames that we find.
392      */
393     idx = strlen(FindData.cFileName)+1;
394     New(1304, p->start, idx, char);
395     if(p->start == NULL) {
396         croak("opendir: malloc failed!\n");
397     }
398     strcpy(p->start, FindData.cFileName);
399 /*  if(downcase)
400  *      strlwr(p->start);
401  */
402     p->nfiles++;
403
404     /* loop finding all the files that match the wildcard
405      * (which should be all of them in this directory!).
406      * the variable idx should point one past the null terminator
407      * of the previous string found.
408      */
409     while (FindNextFile(fh, &FindData)) {
410         len = strlen(FindData.cFileName);
411         /* bump the string table size by enough for the
412          * new name and it's null terminator
413          */
414         Renew(p->start, idx+len+1, char);
415         if(p->start == NULL) {
416             croak("opendir: malloc failed!\n");
417         }
418         strcpy(&p->start[idx], FindData.cFileName);
419 /*      if (downcase) 
420  *          strlwr(&p->start[idx]);
421  */
422                 p->nfiles++;
423                 idx += len+1;
424         }
425         FindClose(fh);
426         p->size = idx;
427         p->curr = p->start;
428         return p;
429 }
430
431
432 /* Readdir just returns the current string pointer and bumps the
433  * string pointer to the nDllExport entry.
434  */
435 struct direct *
436 readdir(DIR *dirp)
437 {
438     int         len;
439     static int  dummy = 0;
440
441     if (dirp->curr) {
442         /* first set up the structure to return */
443         len = strlen(dirp->curr);
444         strcpy(dirp->dirstr.d_name, dirp->curr);
445         dirp->dirstr.d_namlen = len;
446
447         /* Fake an inode */
448         dirp->dirstr.d_ino = dummy++;
449
450         /* Now set up for the nDllExport call to readdir */
451         dirp->curr += len + 1;
452         if (dirp->curr >= (dirp->start + dirp->size)) {
453             dirp->curr = NULL;
454         }
455
456         return &(dirp->dirstr);
457     } 
458     else
459         return NULL;
460 }
461
462 /* Telldir returns the current string pointer position */
463 long
464 telldir(DIR *dirp)
465 {
466     return (long) dirp->curr;
467 }
468
469
470 /* Seekdir moves the string pointer to a previously saved position
471  *(Saved by telldir).
472  */
473 void
474 seekdir(DIR *dirp, long loc)
475 {
476     dirp->curr = (char *)loc;
477 }
478
479 /* Rewinddir resets the string pointer to the start */
480 void
481 rewinddir(DIR *dirp)
482 {
483     dirp->curr = dirp->start;
484 }
485
486 /* free the memory allocated by opendir */
487 int
488 closedir(DIR *dirp)
489 {
490     Safefree(dirp->start);
491     Safefree(dirp);
492     return 1;
493 }
494
495
496 /*
497  * various stubs
498  */
499
500
501 /* Ownership
502  *
503  * Just pretend that everyone is a superuser. NT will let us know if
504  * we don\'t really have permission to do something.
505  */
506
507 #define ROOT_UID    ((uid_t)0)
508 #define ROOT_GID    ((gid_t)0)
509
510 uid_t
511 getuid(void)
512 {
513     return ROOT_UID;
514 }
515
516 uid_t
517 geteuid(void)
518 {
519     return ROOT_UID;
520 }
521
522 gid_t
523 getgid(void)
524 {
525     return ROOT_GID;
526 }
527
528 gid_t
529 getegid(void)
530 {
531     return ROOT_GID;
532 }
533
534 int
535 setuid(uid_t uid)
536
537     return (uid == ROOT_UID ? 0 : -1);
538 }
539
540 int
541 setgid(gid_t gid)
542 {
543     return (gid == ROOT_GID ? 0 : -1);
544 }
545
546 /*
547  * pretended kill
548  */
549 int
550 kill(int pid, int sig)
551 {
552     HANDLE hProcess= OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid);
553
554     if (hProcess == NULL) {
555         croak("kill process failed!\n");
556     }
557     else {
558         if (!TerminateProcess(hProcess, sig))
559             croak("kill process failed!\n");
560         CloseHandle(hProcess);
561     }
562     return 0;
563 }
564       
565 /*
566  * File system stuff
567  */
568
569 #if 0
570 int
571 ioctl(int i, unsigned int u, char *data)
572 {
573     croak("ioctl not implemented!\n");
574     return -1;
575 }
576 #endif
577
578 DllExport unsigned int
579 win32_sleep(unsigned int t)
580 {
581     Sleep(t*1000);
582     return 0;
583 }
584
585 DllExport int
586 win32_stat(const char *path, struct stat *buffer)
587 {
588     char                t[MAX_PATH]; 
589     const char  *p = path;
590     int         l = strlen(path);
591     int         res;
592
593     if (l > 1) {
594         switch(path[l - 1]) {
595         case '\\':
596         case '/':
597             if (path[l - 2] != ':') {
598                 strncpy(t, path, l - 1);
599                 t[l - 1] = 0;
600                 p = t;
601             };
602         }
603     }
604     res = stat(p,buffer);
605 #ifdef __BORLANDC__
606     if (res == 0) {
607         if (S_ISDIR(buffer->st_mode))
608             buffer->st_mode |= S_IWRITE | S_IEXEC;
609         else if (S_ISREG(buffer->st_mode)) {
610             if (l >= 4 && path[l-4] == '.') {
611                 const char *e = path + l - 3;
612                 if (strnicmp(e,"exe",3)
613                     && strnicmp(e,"bat",3)
614                     && strnicmp(e,"com",3)
615                     && (IsWin95() || strnicmp(e,"cmd",3)))
616                     buffer->st_mode &= ~S_IEXEC;
617                 else
618                     buffer->st_mode |= S_IEXEC;
619             }
620             else
621                 buffer->st_mode &= ~S_IEXEC;
622         }
623     }
624 #endif
625     return res;
626 }
627
628 #ifndef USE_WIN32_RTL_ENV
629
630 DllExport char *
631 win32_getenv(const char *name)
632 {
633     static char *curitem = Nullch;
634     static DWORD curlen = 512;
635     DWORD needlen;
636     if (!curitem)
637         New(1305,curitem,curlen,char);
638     if (!(needlen = GetEnvironmentVariable(name,curitem,curlen)))
639         return Nullch;
640     while (needlen > curlen) {
641         Renew(curitem,needlen,char);
642         curlen = needlen;
643         needlen = GetEnvironmentVariable(name,curitem,curlen);
644     }
645     return curitem;
646 }
647
648 #endif
649
650 static long
651 FileTimeToClock(PFILETIME ft)
652 {
653  __int64 qw = ft->dwHighDateTime;
654  qw <<= 32;
655  qw |= ft->dwLowDateTime;
656  qw /= 10000;  /* File time ticks at 0.1uS, clock at 1mS */
657  return (long) qw;
658 }
659
660 DllExport int
661 win32_times(struct tms *timebuf)
662 {
663     FILETIME user;
664     FILETIME kernel;
665     FILETIME dummy;
666     if (GetProcessTimes(GetCurrentProcess(), &dummy, &dummy, 
667                         &kernel,&user)) {
668         timebuf->tms_utime = FileTimeToClock(&user);
669         timebuf->tms_stime = FileTimeToClock(&kernel);
670         timebuf->tms_cutime = 0;
671         timebuf->tms_cstime = 0;
672         
673     } else { 
674         /* That failed - e.g. Win95 fallback to clock() */
675         clock_t t = clock();
676         timebuf->tms_utime = t;
677         timebuf->tms_stime = 0;
678         timebuf->tms_cutime = 0;
679         timebuf->tms_cstime = 0;
680     }
681     return 0;
682 }
683
684 static UINT timerid = 0;
685
686
687 static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time)
688 {
689  KillTimer(NULL,timerid);
690  timerid=0;  
691  sighandler(14);
692 }
693
694 DllExport unsigned int
695 win32_alarm(unsigned int sec)
696 {
697     /* 
698      * the 'obvious' implentation is SetTimer() with a callback
699      * which does whatever receiving SIGALRM would do 
700      * we cannot use SIGALRM even via raise() as it is not 
701      * one of the supported codes in <signal.h>
702      *
703      * Snag is unless something is looking at the message queue
704      * nothing happens :-(
705      */ 
706     if (sec)
707      {
708       timerid = SetTimer(NULL,timerid,sec*1000,(TIMERPROC)TimerProc);
709       if (!timerid)
710        croak("Cannot set timer");
711      } 
712     else
713      {
714       if (timerid)
715        {
716         KillTimer(NULL,timerid);
717         timerid=0;  
718        }
719      }
720     return 0;
721 }
722
723 #ifdef USE_FIXED_OSFHANDLE
724
725 EXTERN_C int __cdecl _alloc_osfhnd(void);
726 EXTERN_C int __cdecl _set_osfhnd(int fh, long value);
727 EXTERN_C void __cdecl _lock_fhandle(int);
728 EXTERN_C void __cdecl _unlock_fhandle(int);
729 EXTERN_C void __cdecl _unlock(int);
730
731 #if     (_MSC_VER >= 1000)
732 typedef struct  {
733     long osfhnd;    /* underlying OS file HANDLE */
734     char osfile;    /* attributes of file (e.g., open in text mode?) */
735     char pipech;    /* one char buffer for handles opened on pipes */
736 #if defined (_MT) && !defined (DLL_FOR_WIN32S)
737     int lockinitflag;
738     CRITICAL_SECTION lock;
739 #endif  /* defined (_MT) && !defined (DLL_FOR_WIN32S) */
740 }       ioinfo;
741
742 EXTERN_C ioinfo * __pioinfo[];
743
744 #define IOINFO_L2E                      5
745 #define IOINFO_ARRAY_ELTS       (1 << IOINFO_L2E)
746 #define _pioinfo(i)     (__pioinfo[i >> IOINFO_L2E] + (i & (IOINFO_ARRAY_ELTS - 1)))
747 #define _osfile(i)      (_pioinfo(i)->osfile)
748
749 #else   /* (_MSC_VER >= 1000) */
750 extern char _osfile[];
751 #endif  /* (_MSC_VER >= 1000) */
752
753 #define FOPEN                   0x01    /* file handle open */
754 #define FAPPEND                 0x20    /* file handle opened O_APPEND */
755 #define FDEV                    0x40    /* file handle refers to device */
756 #define FTEXT                   0x80    /* file handle is in text mode */
757
758 #define _STREAM_LOCKS   26              /* Table of stream locks */
759 #define _LAST_STREAM_LOCK  (_STREAM_LOCKS+_NSTREAM_-1)  /* Last stream lock */
760 #define _FH_LOCKS          (_LAST_STREAM_LOCK+1)        /* Table of fh locks */
761
762 /***
763 *int my_open_osfhandle(long osfhandle, int flags) - open C Runtime file handle
764 *
765 *Purpose:
766 *       This function allocates a free C Runtime file handle and associates
767 *       it with the Win32 HANDLE specified by the first parameter. This is a
768 *               temperary fix for WIN95's brain damage GetFileType() error on socket
769 *               we just bypass that call for socket
770 *
771 *Entry:
772 *       long osfhandle - Win32 HANDLE to associate with C Runtime file handle.
773 *       int flags      - flags to associate with C Runtime file handle.
774 *
775 *Exit:
776 *       returns index of entry in fh, if successful
777 *       return -1, if no free entry is found
778 *
779 *Exceptions:
780 *
781 *******************************************************************************/
782
783 static int
784 my_open_osfhandle(long osfhandle, int flags)
785 {
786     int fh;
787     char fileflags;             /* _osfile flags */
788
789     /* copy relevant flags from second parameter */
790     fileflags = FDEV;
791
792     if(flags & O_APPEND)
793         fileflags |= FAPPEND;
794
795     if(flags & O_TEXT)
796         fileflags |= FTEXT;
797
798     /* attempt to allocate a C Runtime file handle */
799     if((fh = _alloc_osfhnd()) == -1) {
800         errno = EMFILE;         /* too many open files */
801         _doserrno = 0L;         /* not an OS error */
802         return -1;              /* return error to caller */
803     }
804
805     /* the file is open. now, set the info in _osfhnd array */
806     _set_osfhnd(fh, osfhandle);
807
808     fileflags |= FOPEN;         /* mark as open */
809
810 #if (_MSC_VER >= 1000)
811     _osfile(fh) = fileflags;    /* set osfile entry */
812     _unlock_fhandle(fh);
813 #else
814     _osfile[fh] = fileflags;    /* set osfile entry */
815     _unlock(fh+_FH_LOCKS);              /* unlock handle */
816 #endif
817
818     return fh;                  /* return handle */
819 }
820
821 #define _open_osfhandle my_open_osfhandle
822 #endif  /* USE_FIXED_OSFHANDLE */
823
824 /* simulate flock by locking a range on the file */
825
826 #define LK_ERR(f,i)     ((f) ? (i = 0) : (errno = GetLastError()))
827 #define LK_LEN          0xffff0000
828
829 DllExport int
830 win32_flock(int fd, int oper)
831 {
832     OVERLAPPED o;
833     int i = -1;
834     HANDLE fh;
835
836     if (!IsWinNT()) {
837         croak("flock() unimplemented on this platform");
838         return -1;
839     }
840     fh = (HANDLE)_get_osfhandle(fd);
841     memset(&o, 0, sizeof(o));
842
843     switch(oper) {
844     case LOCK_SH:               /* shared lock */
845         LK_ERR(LockFileEx(fh, 0, 0, LK_LEN, 0, &o),i);
846         break;
847     case LOCK_EX:               /* exclusive lock */
848         LK_ERR(LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK, 0, LK_LEN, 0, &o),i);
849         break;
850     case LOCK_SH|LOCK_NB:       /* non-blocking shared lock */
851         LK_ERR(LockFileEx(fh, LOCKFILE_FAIL_IMMEDIATELY, 0, LK_LEN, 0, &o),i);
852         break;
853     case LOCK_EX|LOCK_NB:       /* non-blocking exclusive lock */
854         LK_ERR(LockFileEx(fh,
855                        LOCKFILE_EXCLUSIVE_LOCK|LOCKFILE_FAIL_IMMEDIATELY,
856                        0, LK_LEN, 0, &o),i);
857         break;
858     case LOCK_UN:               /* unlock lock */
859         LK_ERR(UnlockFileEx(fh, 0, LK_LEN, 0, &o),i);
860         break;
861     default:                    /* unknown */
862         errno = EINVAL;
863         break;
864     }
865     return i;
866 }
867
868 #undef LK_ERR
869 #undef LK_LEN
870
871 /*
872  *  redirected io subsystem for all XS modules
873  *
874  */
875
876 DllExport int *
877 win32_errno(void)
878 {
879     return (&errno);
880 }
881
882 DllExport char ***
883 win32_environ(void)
884 {
885     return (&(_environ));
886 }
887
888 /* the rest are the remapped stdio routines */
889 DllExport FILE *
890 win32_stderr(void)
891 {
892     return (stderr);
893 }
894
895 DllExport FILE *
896 win32_stdin(void)
897 {
898     return (stdin);
899 }
900
901 DllExport FILE *
902 win32_stdout()
903 {
904     return (stdout);
905 }
906
907 DllExport int
908 win32_ferror(FILE *fp)
909 {
910     return (ferror(fp));
911 }
912
913
914 DllExport int
915 win32_feof(FILE *fp)
916 {
917     return (feof(fp));
918 }
919
920 /*
921  * Since the errors returned by the socket error function 
922  * WSAGetLastError() are not known by the library routine strerror
923  * we have to roll our own.
924  */
925
926 __declspec(thread) char strerror_buffer[512];
927
928 DllExport char *
929 win32_strerror(int e) 
930 {
931 #ifndef __BORLANDC__            /* Borland intolerance */
932     extern int sys_nerr;
933 #endif
934     DWORD source = 0;
935
936     if(e < 0 || e > sys_nerr) {
937         if(e < 0)
938             e = GetLastError();
939
940         if(FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0,
941                          strerror_buffer, sizeof(strerror_buffer), NULL) == 0) 
942             strcpy(strerror_buffer, "Unknown Error");
943
944         return strerror_buffer;
945     }
946     return strerror(e);
947 }
948
949 DllExport int
950 win32_fprintf(FILE *fp, const char *format, ...)
951 {
952     va_list marker;
953     va_start(marker, format);     /* Initialize variable arguments. */
954
955     return (vfprintf(fp, format, marker));
956 }
957
958 DllExport int
959 win32_printf(const char *format, ...)
960 {
961     va_list marker;
962     va_start(marker, format);     /* Initialize variable arguments. */
963
964     return (vprintf(format, marker));
965 }
966
967 DllExport int
968 win32_vfprintf(FILE *fp, const char *format, va_list args)
969 {
970     return (vfprintf(fp, format, args));
971 }
972
973 DllExport int
974 win32_vprintf(const char *format, va_list args)
975 {
976     return (vprintf(format, args));
977 }
978
979 DllExport size_t
980 win32_fread(void *buf, size_t size, size_t count, FILE *fp)
981 {
982     return fread(buf, size, count, fp);
983 }
984
985 DllExport size_t
986 win32_fwrite(const void *buf, size_t size, size_t count, FILE *fp)
987 {
988     return fwrite(buf, size, count, fp);
989 }
990
991 DllExport FILE *
992 win32_fopen(const char *filename, const char *mode)
993 {
994     if (stricmp(filename, "/dev/null")==0)
995         return fopen("NUL", mode);
996     return fopen(filename, mode);
997 }
998
999 #ifndef USE_SOCKETS_AS_HANDLES
1000 #undef fdopen
1001 #define fdopen my_fdopen
1002 #endif
1003
1004 DllExport FILE *
1005 win32_fdopen( int handle, const char *mode)
1006 {
1007     return fdopen(handle, (char *) mode);
1008 }
1009
1010 DllExport FILE *
1011 win32_freopen( const char *path, const char *mode, FILE *stream)
1012 {
1013     if (stricmp(path, "/dev/null")==0)
1014         return freopen("NUL", mode, stream);
1015     return freopen(path, mode, stream);
1016 }
1017
1018 DllExport int
1019 win32_fclose(FILE *pf)
1020 {
1021     return my_fclose(pf);       /* defined in win32sck.c */
1022 }
1023
1024 DllExport int
1025 win32_fputs(const char *s,FILE *pf)
1026 {
1027     return fputs(s, pf);
1028 }
1029
1030 DllExport int
1031 win32_fputc(int c,FILE *pf)
1032 {
1033     return fputc(c,pf);
1034 }
1035
1036 DllExport int
1037 win32_ungetc(int c,FILE *pf)
1038 {
1039     return ungetc(c,pf);
1040 }
1041
1042 DllExport int
1043 win32_getc(FILE *pf)
1044 {
1045     return getc(pf);
1046 }
1047
1048 DllExport int
1049 win32_fileno(FILE *pf)
1050 {
1051     return fileno(pf);
1052 }
1053
1054 DllExport void
1055 win32_clearerr(FILE *pf)
1056 {
1057     clearerr(pf);
1058     return;
1059 }
1060
1061 DllExport int
1062 win32_fflush(FILE *pf)
1063 {
1064     return fflush(pf);
1065 }
1066
1067 DllExport long
1068 win32_ftell(FILE *pf)
1069 {
1070     return ftell(pf);
1071 }
1072
1073 DllExport int
1074 win32_fseek(FILE *pf,long offset,int origin)
1075 {
1076     return fseek(pf, offset, origin);
1077 }
1078
1079 DllExport int
1080 win32_fgetpos(FILE *pf,fpos_t *p)
1081 {
1082     return fgetpos(pf, p);
1083 }
1084
1085 DllExport int
1086 win32_fsetpos(FILE *pf,const fpos_t *p)
1087 {
1088     return fsetpos(pf, p);
1089 }
1090
1091 DllExport void
1092 win32_rewind(FILE *pf)
1093 {
1094     rewind(pf);
1095     return;
1096 }
1097
1098 DllExport FILE*
1099 win32_tmpfile(void)
1100 {
1101     return tmpfile();
1102 }
1103
1104 DllExport void
1105 win32_abort(void)
1106 {
1107     abort();
1108     return;
1109 }
1110
1111 DllExport int
1112 win32_fstat(int fd,struct stat *bufptr)
1113 {
1114     return fstat(fd,bufptr);
1115 }
1116
1117 DllExport int
1118 win32_pipe(int *pfd, unsigned int size, int mode)
1119 {
1120     return _pipe(pfd, size, mode);
1121 }
1122
1123 DllExport FILE*
1124 win32_popen(const char *command, const char *mode)
1125 {
1126     return _popen(command, mode);
1127 }
1128
1129 DllExport int
1130 win32_pclose(FILE *pf)
1131 {
1132     return _pclose(pf);
1133 }
1134
1135 DllExport int
1136 win32_setmode(int fd, int mode)
1137 {
1138     return setmode(fd, mode);
1139 }
1140
1141 DllExport long
1142 win32_lseek(int fd, long offset, int origin)
1143 {
1144     return lseek(fd, offset, origin);
1145 }
1146
1147 DllExport long
1148 win32_tell(int fd)
1149 {
1150     return tell(fd);
1151 }
1152
1153 DllExport int
1154 win32_open(const char *path, int flag, ...)
1155 {
1156     va_list ap;
1157     int pmode;
1158
1159     va_start(ap, flag);
1160     pmode = va_arg(ap, int);
1161     va_end(ap);
1162
1163     if (stricmp(path, "/dev/null")==0)
1164         return open("NUL", flag, pmode);
1165     return open(path,flag,pmode);
1166 }
1167
1168 DllExport int
1169 win32_close(int fd)
1170 {
1171     return close(fd);
1172 }
1173
1174 DllExport int
1175 win32_eof(int fd)
1176 {
1177     return eof(fd);
1178 }
1179
1180 DllExport int
1181 win32_dup(int fd)
1182 {
1183     return dup(fd);
1184 }
1185
1186 DllExport int
1187 win32_dup2(int fd1,int fd2)
1188 {
1189     return dup2(fd1,fd2);
1190 }
1191
1192 DllExport int
1193 win32_read(int fd, void *buf, unsigned int cnt)
1194 {
1195     return read(fd, buf, cnt);
1196 }
1197
1198 DllExport int
1199 win32_write(int fd, const void *buf, unsigned int cnt)
1200 {
1201     return write(fd, buf, cnt);
1202 }
1203
1204 DllExport int
1205 win32_mkdir(const char *dir, int mode)
1206 {
1207     return mkdir(dir); /* just ignore mode */
1208 }
1209
1210 DllExport int
1211 win32_rmdir(const char *dir)
1212 {
1213     return rmdir(dir);
1214 }
1215
1216 DllExport int
1217 win32_chdir(const char *dir)
1218 {
1219     return chdir(dir);
1220 }
1221
1222 DllExport int
1223 win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
1224 {
1225     return spawnvp(mode, cmdname, (char * const *) argv);
1226 }
1227
1228 DllExport int
1229 win32_execvp(const char *cmdname, const char *const *argv)
1230 {
1231     return execvp(cmdname, (char *const *)argv);
1232 }
1233
1234 DllExport void
1235 win32_perror(const char *str)
1236 {
1237     perror(str);
1238 }
1239
1240 DllExport void
1241 win32_setbuf(FILE *pf, char *buf)
1242 {
1243     setbuf(pf, buf);
1244 }
1245
1246 DllExport int
1247 win32_setvbuf(FILE *pf, char *buf, int type, size_t size)
1248 {
1249     return setvbuf(pf, buf, type, size);
1250 }
1251
1252 DllExport int
1253 win32_flushall(void)
1254 {
1255     return flushall();
1256 }
1257
1258 DllExport int
1259 win32_fcloseall(void)
1260 {
1261     return fcloseall();
1262 }
1263
1264 DllExport char*
1265 win32_fgets(char *s, int n, FILE *pf)
1266 {
1267     return fgets(s, n, pf);
1268 }
1269
1270 DllExport char*
1271 win32_gets(char *s)
1272 {
1273     return gets(s);
1274 }
1275
1276 DllExport int
1277 win32_fgetc(FILE *pf)
1278 {
1279     return fgetc(pf);
1280 }
1281
1282 DllExport int
1283 win32_putc(int c, FILE *pf)
1284 {
1285     return putc(c,pf);
1286 }
1287
1288 DllExport int
1289 win32_puts(const char *s)
1290 {
1291     return puts(s);
1292 }
1293
1294 DllExport int
1295 win32_getchar(void)
1296 {
1297     return getchar();
1298 }
1299
1300 DllExport int
1301 win32_putchar(int c)
1302 {
1303     return putchar(c);
1304 }
1305
1306 DllExport void*
1307 win32_malloc(size_t size)
1308 {
1309     return malloc(size);
1310 }
1311
1312 DllExport void*
1313 win32_calloc(size_t numitems, size_t size)
1314 {
1315     return calloc(numitems,size);
1316 }
1317
1318 DllExport void*
1319 win32_realloc(void *block, size_t size)
1320 {
1321     return realloc(block,size);
1322 }
1323
1324 DllExport void
1325 win32_free(void *block)
1326 {
1327     free(block);
1328 }
1329
1330 int
1331 win32_open_osfhandle(long handle, int flags)
1332 {
1333     return _open_osfhandle(handle, flags);
1334 }
1335
1336 long
1337 win32_get_osfhandle(int fd)
1338 {
1339     return _get_osfhandle(fd);
1340 }
1341
1342 /*
1343  * Extras.
1344  */
1345
1346 static
1347 XS(w32_GetCwd)
1348 {
1349     dXSARGS;
1350     SV *sv = sv_newmortal();
1351     /* Make one call with zero size - return value is required size */
1352     DWORD len = GetCurrentDirectory((DWORD)0,NULL);
1353     SvUPGRADE(sv,SVt_PV);
1354     SvGROW(sv,len);
1355     SvCUR(sv) = GetCurrentDirectory((DWORD) SvLEN(sv), SvPVX(sv));
1356     /* 
1357      * If result != 0 
1358      *   then it worked, set PV valid, 
1359      *   else leave it 'undef' 
1360      */
1361     if (SvCUR(sv))
1362         SvPOK_on(sv);
1363     EXTEND(sp,1);
1364     ST(0) = sv;
1365     XSRETURN(1);
1366 }
1367
1368 static
1369 XS(w32_SetCwd)
1370 {
1371     dXSARGS;
1372     if (items != 1)
1373         croak("usage: Win32::SetCurrentDirectory($cwd)");
1374     if (SetCurrentDirectory(SvPV(ST(0),na)))
1375         XSRETURN_YES;
1376
1377     XSRETURN_NO;
1378 }
1379
1380 static
1381 XS(w32_GetNextAvailDrive)
1382 {
1383     dXSARGS;
1384     char ix = 'C';
1385     char root[] = "_:\\";
1386     while (ix <= 'Z') {
1387         root[0] = ix++;
1388         if (GetDriveType(root) == 1) {
1389             root[2] = '\0';
1390             XSRETURN_PV(root);
1391         }
1392     }
1393     XSRETURN_UNDEF;
1394 }
1395
1396 static
1397 XS(w32_GetLastError)
1398 {
1399     dXSARGS;
1400     XSRETURN_IV(GetLastError());
1401 }
1402
1403 static
1404 XS(w32_LoginName)
1405 {
1406     dXSARGS;
1407     char name[256];
1408     DWORD size = sizeof(name);
1409     if (GetUserName(name,&size)) {
1410         /* size includes NULL */
1411         ST(0) = sv_2mortal(newSVpv(name,size-1));
1412         XSRETURN(1);
1413     }
1414     XSRETURN_UNDEF;
1415 }
1416
1417 static
1418 XS(w32_NodeName)
1419 {
1420     dXSARGS;
1421     char name[MAX_COMPUTERNAME_LENGTH+1];
1422     DWORD size = sizeof(name);
1423     if (GetComputerName(name,&size)) {
1424         /* size does NOT include NULL :-( */
1425         ST(0) = sv_2mortal(newSVpv(name,size));
1426         XSRETURN(1);
1427     }
1428     XSRETURN_UNDEF;
1429 }
1430
1431
1432 static
1433 XS(w32_DomainName)
1434 {
1435     dXSARGS;
1436     char name[256];
1437     DWORD size = sizeof(name);
1438     if (GetUserName(name,&size)) {
1439         char sid[1024];
1440         DWORD sidlen = sizeof(sid);
1441         char dname[256];
1442         DWORD dnamelen = sizeof(dname);
1443         SID_NAME_USE snu;
1444         if (LookupAccountName(NULL, name, &sid, &sidlen,
1445                               dname, &dnamelen, &snu)) {
1446             XSRETURN_PV(dname);         /* all that for this */
1447         }
1448     }
1449     XSRETURN_UNDEF;
1450 }
1451
1452 static
1453 XS(w32_FsType)
1454 {
1455     dXSARGS;
1456     char fsname[256];
1457     DWORD flags, filecomplen;
1458     if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
1459                          &flags, fsname, sizeof(fsname))) {
1460         if (GIMME == G_ARRAY) {
1461             XPUSHs(sv_2mortal(newSVpv(fsname,0)));
1462             XPUSHs(sv_2mortal(newSViv(flags)));
1463             XPUSHs(sv_2mortal(newSViv(filecomplen)));
1464             PUTBACK;
1465             return;
1466         }
1467         XSRETURN_PV(fsname);
1468     }
1469     XSRETURN_UNDEF;
1470 }
1471
1472 static
1473 XS(w32_GetOSVersion)
1474 {
1475     dXSARGS;
1476     OSVERSIONINFO osver;
1477
1478     osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
1479     if (GetVersionEx(&osver)) {
1480         XPUSHs(newSVpv(osver.szCSDVersion, 0));
1481         XPUSHs(newSViv(osver.dwMajorVersion));
1482         XPUSHs(newSViv(osver.dwMinorVersion));
1483         XPUSHs(newSViv(osver.dwBuildNumber));
1484         XPUSHs(newSViv(osver.dwPlatformId));
1485         PUTBACK;
1486         return;
1487     }
1488     XSRETURN_UNDEF;
1489 }
1490
1491 static
1492 XS(w32_IsWinNT)
1493 {
1494     dXSARGS;
1495     XSRETURN_IV(IsWinNT());
1496 }
1497
1498 static
1499 XS(w32_IsWin95)
1500 {
1501     dXSARGS;
1502     XSRETURN_IV(IsWin95());
1503 }
1504
1505 static
1506 XS(w32_FormatMessage)
1507 {
1508     dXSARGS;
1509     DWORD source = 0;
1510     char msgbuf[1024];
1511
1512     if (items != 1)
1513         croak("usage: Win32::FormatMessage($errno)");
1514
1515     if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,
1516                       &source, SvIV(ST(0)), 0,
1517                       msgbuf, sizeof(msgbuf)-1, NULL))
1518         XSRETURN_PV(msgbuf);
1519
1520     XSRETURN_UNDEF;
1521 }
1522
1523 static
1524 XS(w32_Spawn)
1525 {
1526     dXSARGS;
1527     char *cmd, *args;
1528     PROCESS_INFORMATION stProcInfo;
1529     STARTUPINFO stStartInfo;
1530     BOOL bSuccess = FALSE;
1531
1532     if(items != 3)
1533         croak("usage: Win32::Spawn($cmdName, $args, $PID)");
1534
1535     cmd = SvPV(ST(0),na);
1536     args = SvPV(ST(1), na);
1537
1538     memset(&stStartInfo, 0, sizeof(stStartInfo));   /* Clear the block */
1539     stStartInfo.cb = sizeof(stStartInfo);           /* Set the structure size */
1540     stStartInfo.dwFlags = STARTF_USESHOWWINDOW;     /* Enable wShowWindow control */
1541     stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE;   /* Start min (normal) */
1542
1543     if(CreateProcess(
1544                 cmd,                    /* Image path */
1545                 args,                   /* Arguments for command line */
1546                 NULL,                   /* Default process security */
1547                 NULL,                   /* Default thread security */
1548                 FALSE,                  /* Must be TRUE to use std handles */
1549                 NORMAL_PRIORITY_CLASS,  /* No special scheduling */
1550                 NULL,                   /* Inherit our environment block */
1551                 NULL,                   /* Inherit our currrent directory */
1552                 &stStartInfo,           /* -> Startup info */
1553                 &stProcInfo))           /* <- Process info (if OK) */
1554     {
1555         CloseHandle(stProcInfo.hThread);/* library source code does this. */
1556         sv_setiv(ST(2), stProcInfo.dwProcessId);
1557         bSuccess = TRUE;
1558     }
1559     XSRETURN_IV(bSuccess);
1560 }
1561
1562 static
1563 XS(w32_GetTickCount)
1564 {
1565     dXSARGS;
1566     XSRETURN_IV(GetTickCount());
1567 }
1568
1569 static
1570 XS(w32_GetShortPathName)
1571 {
1572     dXSARGS;
1573     SV *shortpath;
1574     DWORD len;
1575
1576     if(items != 1)
1577         croak("usage: Win32::GetShortPathName($longPathName)");
1578
1579     shortpath = sv_mortalcopy(ST(0));
1580     SvUPGRADE(shortpath, SVt_PV);
1581     /* src == target is allowed */
1582     do {
1583         len = GetShortPathName(SvPVX(shortpath),
1584                                SvPVX(shortpath),
1585                                SvLEN(shortpath));
1586     } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1));
1587     if (len) {
1588         SvCUR_set(shortpath,len);
1589         ST(0) = shortpath;
1590     }
1591     else
1592         ST(0) = &sv_undef;
1593     XSRETURN(1);
1594 }
1595
1596 void
1597 Perl_init_os_extras()
1598 {
1599     char *file = __FILE__;
1600     dXSUB_SYS;
1601
1602     /* XXX should be removed after checking with Nick */
1603     newXS("Win32::GetCurrentDirectory", w32_GetCwd, file);
1604
1605     /* these names are Activeware compatible */
1606     newXS("Win32::GetCwd", w32_GetCwd, file);
1607     newXS("Win32::SetCwd", w32_SetCwd, file);
1608     newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
1609     newXS("Win32::GetLastError", w32_GetLastError, file);
1610     newXS("Win32::LoginName", w32_LoginName, file);
1611     newXS("Win32::NodeName", w32_NodeName, file);
1612     newXS("Win32::DomainName", w32_DomainName, file);
1613     newXS("Win32::FsType", w32_FsType, file);
1614     newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
1615     newXS("Win32::IsWinNT", w32_IsWinNT, file);
1616     newXS("Win32::IsWin95", w32_IsWin95, file);
1617     newXS("Win32::FormatMessage", w32_FormatMessage, file);
1618     newXS("Win32::Spawn", w32_Spawn, file);
1619     newXS("Win32::GetTickCount", w32_GetTickCount, file);
1620     newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
1621
1622     /* XXX Bloat Alert! The following Activeware preloads really
1623      * ought to be part of Win32::Sys::*, so they're not included
1624      * here.
1625      */
1626     /* LookupAccountName
1627      * LookupAccountSID
1628      * InitiateSystemShutdown
1629      * AbortSystemShutdown
1630      * ExpandEnvrironmentStrings
1631      */
1632 }
1633
1634 void
1635 Perl_win32_init(int *argcp, char ***argvp)
1636 {
1637     /* Disable floating point errors, Perl will trap the ones we
1638      * care about.  VC++ RTL defaults to switching these off
1639      * already, but the Borland RTL doesn't.  Since we don't
1640      * want to be at the vendor's whim on the default, we set
1641      * it explicitly here.
1642      */
1643 #if !defined(_ALPHA_)
1644     _control87(MCW_EM, MCW_EM);
1645 #endif
1646 }
1647
1648
1649
1650