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