add Pod-Parser-1.08 (verbatim module =include tests elided owing
[p5sagit/p5-mst-13.2.git] / win32 / win32.c
index 1ee0587..4d7721e 100644 (file)
 #endif
 #include <windows.h>
 
+#ifndef __MINGW32__
+#include <lmcons.h>
+#include <lmerr.h>
+/* ugliness to work around a buggy struct definition in lmwksta.h */
+#undef LPTSTR
+#define LPTSTR LPWSTR
+#include <lmwksta.h>
+#undef LPTSTR
+#define LPTSTR LPSTR
+#include <lmapibuf.h>
+#endif /* __MINGW32__ */
+
 /* #include "config.h" */
 
 #define PERLIO_NOT_STDIO 0 
 
 #include "EXTERN.h"
 #include "perl.h"
+
+#define NO_XSLOCKS
+#ifdef PERL_OBJECT
+extern CPerlObj* pPerl;
+#endif
 #include "XSUB.h"
+
+#include "Win32iop.h"
 #include <fcntl.h>
 #include <sys/stat.h>
 #ifndef __GNUC__
@@ -53,56 +72,56 @@ int _CRT_glob = 0;
 #define EXECF_SPAWN 2
 #define EXECF_SPAWN_NOWAIT 3
 
+#if defined(PERL_OBJECT)
+#undef win32_get_privlib
+#define win32_get_privlib g_win32_get_privlib
+#undef win32_get_sitelib
+#define win32_get_sitelib g_win32_get_sitelib
+#undef do_aspawn
+#define do_aspawn g_do_aspawn
+#undef do_spawn
+#define do_spawn g_do_spawn
+#undef do_exec
+#define do_exec g_do_exec
+#undef getlogin
+#define getlogin g_getlogin
+#endif
+
 static DWORD           os_id(void);
 static void            get_shell(void);
 static long            tokenize(char *str, char **dest, char ***destv);
-static int             do_spawn2(char *cmd, int exectype);
-static BOOL            has_redirection(char *ptr);
+       int             do_spawn2(char *cmd, int exectype);
+static BOOL            has_shell_metachars(char *ptr);
 static long            filetime_to_clock(PFILETIME ft);
 static BOOL            filetime_from_time(PFILETIME ft, time_t t);
+static char *          get_emd_part(char *leading, char *trailing, ...);
+static void            remove_dead_process(long deceased);
+static long            find_pid(int pid);
+static char *          qualified_path(const char *cmd);
 
-char * w32_perlshell_tokens = Nullch;
-char **        w32_perlshell_vec;
-long   w32_perlshell_items = -1;
-DWORD  w32_platform = (DWORD)-1;
-char   w32_perllib_root[MAX_PATH+1];
 HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE;
-#ifndef __BORLANDC__
-long   w32_num_children = 0;
-HANDLE w32_child_pids[MAXIMUM_WAIT_OBJECTS];
-#endif
-
-#ifndef FOPEN_MAX
-#  ifdef _NSTREAM_
-#    define FOPEN_MAX _NSTREAM_
-#  elsif _NFILE_
-#    define FOPEN_MAX _NFILE_
-#  elsif _NFILE
-#    define FOPEN_MAX _NFILE
-#  endif
-#endif
-
-#ifndef USE_CRT_POPEN
-int    w32_popen_pids[FOPEN_MAX];
-#endif
+static DWORD   w32_platform = (DWORD)-1;
 
 #ifdef USE_THREADS
 #  ifdef USE_DECLSPEC_THREAD
 __declspec(thread) char        strerror_buffer[512];
 __declspec(thread) char        getlogin_buffer[128];
+__declspec(thread) char        w32_perllib_root[MAX_PATH+1];
 #    ifdef HAVE_DES_FCRYPT
 __declspec(thread) char        crypt_buffer[30];
 #    endif
 #  else
 #    define strerror_buffer    (thr->i.Wstrerror_buffer)
 #    define getlogin_buffer    (thr->i.Wgetlogin_buffer)
+#    define w32_perllib_root   (thr->i.Ww32_perllib_root)
 #    define crypt_buffer       (thr->i.Wcrypt_buffer)
 #  endif
 #else
-char   strerror_buffer[512];
-char   getlogin_buffer[128];
+static char    strerror_buffer[512];
+static char    getlogin_buffer[128];
+static char    w32_perllib_root[MAX_PATH+1];
 #  ifdef HAVE_DES_FCRYPT
-char   crypt_buffer[30];
+static char    crypt_buffer[30];
 #  endif
 #endif
 
@@ -116,48 +135,191 @@ IsWinNT(void) {
     return (os_id() == VER_PLATFORM_WIN32_NT);
 }
 
-char *
-win32_perllib_path(char *sfx,...)
+char*
+GetRegStrFromKey(HKEY hkey, const char *lpszValueName, char** ptr, DWORD* lpDataLen)
+{   /* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */
+    HKEY handle;
+    DWORD type;
+    const char *subkey = "Software\\Perl";
+    long retval;
+
+    retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
+    if (retval == ERROR_SUCCESS){
+       retval = RegQueryValueEx(handle, lpszValueName, 0, &type, NULL, lpDataLen);
+       if (retval == ERROR_SUCCESS && type == REG_SZ) {
+           if (*ptr) {
+               Renew(*ptr, *lpDataLen, char);
+           }
+           else {
+               New(1312, *ptr, *lpDataLen, char);
+           }
+           retval = RegQueryValueEx(handle, lpszValueName, 0, NULL, (PBYTE)*ptr, lpDataLen);
+           if (retval != ERROR_SUCCESS) {
+               Safefree(*ptr);
+               *ptr = Nullch;
+           }
+       }
+       RegCloseKey(handle);
+    }
+    return *ptr;
+}
+
+char*
+GetRegStr(const char *lpszValueName, char** ptr, DWORD* lpDataLen)
+{
+    *ptr = GetRegStrFromKey(HKEY_CURRENT_USER, lpszValueName, ptr, lpDataLen);
+    if (*ptr == Nullch)
+    {
+       *ptr = GetRegStrFromKey(HKEY_LOCAL_MACHINE, lpszValueName, ptr, lpDataLen);
+    }
+    return *ptr;
+}
+
+static char *
+get_emd_part(char *prev_path, char *trailing_path, ...)
 {
+    char base[10];
     va_list ap;
-    char *end;
-    va_start(ap,sfx);
-    GetModuleFileName((w32_perldll_handle == INVALID_HANDLE_VALUE) 
-                     ? GetModuleHandle(NULL)
-                     : w32_perldll_handle,
-                     w32_perllib_root, 
-                     sizeof(w32_perllib_root));
-    *(end = strrchr(w32_perllib_root, '\\')) = '\0';
-    if (stricmp(end-4,"\\bin") == 0)
-     end -= 4;
-    strcpy(end,"\\lib");
-    while (sfx)
-     {
-      strcat(end,"\\");
-      strcat(end,sfx);
-      sfx = va_arg(ap,char *);
-     }
-    va_end(ap); 
-    return (w32_perllib_root);
+    char mod_name[MAX_PATH+1];
+    char *ptr;
+    char *optr;
+    char *strip;
+    int oldsize, newsize;
+
+    va_start(ap, trailing_path);
+    strip = va_arg(ap, char *);
+
+    sprintf(base, "%5.3f",
+           (double)PERL_REVISION + ((double)PERL_VERSION / (double)1000));
+
+    GetModuleFileName((HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE)
+                               ? GetModuleHandle(NULL) : w32_perldll_handle),
+                     mod_name, sizeof(mod_name));
+    ptr = strrchr(mod_name, '\\');
+    while (ptr && strip) {
+        /* look for directories to skip back */
+       optr = ptr;
+       *ptr = '\0';
+       ptr = strrchr(mod_name, '\\');
+       if (!ptr || stricmp(ptr+1, strip) != 0) {
+           if(!(*strip == '5' && *(ptr+1) == '5' && strncmp(strip, base, 5) == 0
+                   && strncmp(ptr+1, base, 5) == 0)) {
+               *optr = '\\';
+               ptr = optr;
+           }
+       }
+       strip = va_arg(ap, char *);
+    }
+    if (!ptr) {
+       ptr = mod_name;
+       *ptr++ = '.';
+       *ptr = '\\';
+    }
+    va_end(ap);
+    strcpy(++ptr, trailing_path);
+
+    /* only add directory if it exists */
+    if(GetFileAttributes(mod_name) != (DWORD) -1) {
+       /* directory exists */
+       newsize = strlen(mod_name) + 1;
+       if (prev_path) {
+           oldsize = strlen(prev_path) + 1;
+           newsize += oldsize;                 /* includes plus 1 for ';' */
+           Renew(prev_path, newsize, char);
+           prev_path[oldsize-1] = ';';
+           strcpy(&prev_path[oldsize], mod_name);
+       }
+       else {
+           New(1311, prev_path, newsize, char);
+           strcpy(prev_path, mod_name);
+       }
+    }
+
+    return prev_path;
+}
+
+char *
+win32_get_privlib(char *pl)
+{
+    char *stdlib = "lib";
+    char buffer[MAX_PATH+1];
+    char *path = Nullch;
+    DWORD datalen;
+
+    /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || "";  */
+    sprintf(buffer, "%s-%s", stdlib, pl);
+    path = GetRegStr(buffer, &path, &datalen);
+    if (!path)
+       path = GetRegStr(stdlib, &path, &datalen);
+
+    /* $stdlib .= ";$EMD/../../lib" */
+    return get_emd_part(path, stdlib, ARCHNAME, "bin", Nullch);
+}
+
+char *
+win32_get_sitelib(char *pl)
+{
+    char *sitelib = "sitelib";
+    char regstr[40];
+    char pathstr[MAX_PATH+1];
+    DWORD datalen;
+    char *path1 = Nullch;
+    char *path2 = Nullch;
+    int len, newsize;
+
+    /* $HKCU{"sitelib-$]"} || $HKLM{"sitelib-$]"} . ---; */
+    sprintf(regstr, "%s-%s", sitelib, pl);
+    path1 = GetRegStr(regstr, &path1, &datalen);
+
+    /* $sitelib .=
+     * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/$]/lib";  */
+    sprintf(pathstr, "site\\%s\\lib", pl);
+    path1 = get_emd_part(path1, pathstr, ARCHNAME, "bin", pl, Nullch);
+
+    /* $HKCU{'sitelib'} || $HKLM{'sitelib'} . ---; */
+    path2 = GetRegStr(sitelib, &path2, &datalen);
+
+    /* $sitelib .=
+     * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/lib";  */
+    path2 = get_emd_part(path2, "site\\lib", ARCHNAME, "bin", pl, Nullch);
+
+    if (!path1)
+       return path2;
+
+    if (!path2)
+       return path1;
+
+    len = strlen(path1);
+    newsize = len + strlen(path2) + 2; /* plus one for ';' */
+
+    Renew(path1, newsize, char);
+    path1[len++] = ';';
+    strcpy(&path1[len], path2);
+
+    Safefree(path2);
+    return path1;
 }
 
 
 static BOOL
-has_redirection(char *ptr)
+has_shell_metachars(char *ptr)
 {
     int inquote = 0;
     char quote = '\0';
 
     /*
      * Scan string looking for redirection (< or >) or pipe
-     * characters (|) that are not in a quoted string
+     * characters (|) that are not in a quoted string.
+     * Shell variable interpolation (%VAR%) can also happen inside strings.
      */
-    while(*ptr) {
+    while (*ptr) {
        switch(*ptr) {
+       case '%':
+           return TRUE;
        case '\'':
        case '\"':
-           if(inquote) {
-               if(quote == *ptr) {
+           if (inquote) {
+               if (quote == *ptr) {
                    inquote = 0;
                    quote = '\0';
                }
@@ -170,7 +332,7 @@ has_redirection(char *ptr)
        case '>':
        case '<':
        case '|':
-           if(!inquote)
+           if (!inquote)
                return TRUE;
        default:
            break;
@@ -180,6 +342,7 @@ has_redirection(char *ptr)
     return FALSE;
 }
 
+#if !defined(PERL_OBJECT)
 /* since the current process environment is being updated in util.c
  * the library functions will get the correct environment
  */
@@ -212,6 +375,7 @@ my_pclose(PerlIO *fp)
 {
     return win32_pclose(fp);
 }
+#endif
 
 static DWORD
 os_id(void)
@@ -321,8 +485,8 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
        flag = SvIVx(*mark);
     }
 
-    while(++mark <= sp) {
-       if (*mark && (str = SvPV(*mark, na)))
+    while (++mark <= sp) {
+       if (*mark && (str = SvPV_nolen(*mark)))
            argv[index++] = str;
        else
            argv[index++] = "";
@@ -330,10 +494,10 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
     argv[index++] = 0;
    
     status = win32_spawnvp(flag,
-                          (really ? SvPV(really,na) : argv[0]),
+                          (const char*)(really ? SvPV_nolen(really) : argv[0]),
                           (const char* const*)argv);
 
-    if (status < 0 && errno == ENOEXEC) {
+    if (status < 0 && (errno == ENOEXEC || errno == ENOENT)) {
        /* possible shell-builtin, invoke with shell */
        int sh_items;
        sh_items = w32_perlshell_items;
@@ -343,25 +507,25 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
            argv[sh_items] = w32_perlshell_vec[sh_items];
    
        status = win32_spawnvp(flag,
-                              (really ? SvPV(really,na) : argv[0]),
+                              (const char*)(really ? SvPV_nolen(really) : argv[0]),
                               (const char* const*)argv);
     }
 
     if (flag != P_NOWAIT) {
        if (status < 0) {
-           if (dowarn)
+           if (PL_dowarn)
                warn("Can't spawn \"%s\": %s", argv[0], strerror(errno));
            status = 255 * 256;
        }
        else
            status *= 256;
-       statusvalue = status;
+       PL_statusvalue = status;
     }
     Safefree(argv);
     return (status);
 }
 
-static int
+int
 do_spawn2(char *cmd, int exectype)
 {
     char **a;
@@ -373,7 +537,7 @@ do_spawn2(char *cmd, int exectype)
 
     /* Save an extra exec if possible. See if there are shell
      * metacharacters in it */
-    if(!has_redirection(cmd)) {
+    if (!has_shell_metachars(cmd)) {
        New(1301,argv, strlen(cmd) / 2 + 2, char*);
        New(1302,cmd2, strlen(cmd) + 1, char);
        strcpy(cmd2, cmd);
@@ -383,9 +547,9 @@ do_spawn2(char *cmd, int exectype)
                s++;
            if (*s)
                *(a++) = s;
-           while(*s && !isspace(*s))
+           while (*s && !isspace(*s))
                s++;
-           if(*s)
+           if (*s)
                *s++ = '\0';
        }
        *a = Nullch;
@@ -436,7 +600,7 @@ do_spawn2(char *cmd, int exectype)
     }
     if (exectype != EXECF_SPAWN_NOWAIT) {
        if (status < 0) {
-           if (dowarn)
+           if (PL_dowarn)
                warn("Can't %s \"%s\": %s",
                     (exectype == EXECF_EXEC ? "exec" : "spawn"),
                     cmd, strerror(errno));
@@ -444,7 +608,7 @@ do_spawn2(char *cmd, int exectype)
        }
        else
            status *= 256;
-       statusvalue = status;
+       PL_statusvalue = status;
     }
     return (status);
 }
@@ -468,67 +632,48 @@ do_exec(char *cmd)
     return FALSE;
 }
 
-
-#define PATHLEN 1024
-
 /* The idea here is to read all the directory names into a string table
  * (separated by nulls) and when one of the other dir functions is called
  * return the pointer to the current file name.
  */
 DIR *
-opendir(char *filename)
-{
-    DIR            *p;
-    long            len;
-    long            idx;
-    char            scannamespc[PATHLEN];
-    char       *scanname = scannamespc;
-    struct stat     sbuf;
-    WIN32_FIND_DATA FindData;
-    HANDLE          fh;
-/*  char            root[_MAX_PATH];*/
-/*  char            volname[_MAX_PATH];*/
-/*  DWORD           serial, maxname, flags;*/
-/*  BOOL            downcase;*/
-/*  char           *dummy;*/
+win32_opendir(char *filename)
+{
+    DIR                        *p;
+    long               len;
+    long               idx;
+    char               scanname[MAX_PATH+3];
+    struct stat                sbuf;
+    WIN32_FIND_DATA    FindData;
+    HANDLE             fh;
+
+    len = strlen(filename);
+    if (len > MAX_PATH)
+       return NULL;
 
     /* check to see if filename is a directory */
-    if (win32_stat(filename, &sbuf) < 0 || (sbuf.st_mode & S_IFDIR) == 0) {
-       /* CRT is buggy on sharenames, so make sure it really isn't */
-       DWORD r = GetFileAttributes(filename);
-       if (r == 0xffffffff || !(r & FILE_ATTRIBUTE_DIRECTORY))
-           return NULL;
-    }
-
-    /* get the file system characteristics */
-/*  if(GetFullPathName(filename, MAX_PATH, root, &dummy)) {
- *     if(dummy = strchr(root, '\\'))
- *         *++dummy = '\0';
- *     if(GetVolumeInformation(root, volname, MAX_PATH, &serial,
- *                             &maxname, &flags, 0, 0)) {
- *         downcase = !(flags & FS_CASE_IS_PRESERVED);
- *     }
- *  }
- *  else {
- *     downcase = TRUE;
- *  }
- */
+    if (win32_stat(filename, &sbuf) < 0 || !S_ISDIR(sbuf.st_mode))
+       return NULL;
+
     /* Get us a DIR structure */
     Newz(1303, p, 1, DIR);
-    if(p == NULL)
+    if (p == NULL)
        return NULL;
 
     /* Create the search pattern */
     strcpy(scanname, filename);
-
-    if(index("/\\", *(scanname + strlen(scanname) - 1)) == NULL)
-       strcat(scanname, "/*");
-    else
-       strcat(scanname, "*");
+    if (scanname[len-1] != '/' && scanname[len-1] != '\\')
+       scanname[len++] = '/';
+    scanname[len++] = '*';
+    scanname[len] = '\0';
 
     /* do the FindFirstFile call */
     fh = FindFirstFile(scanname, &FindData);
-    if(fh == INVALID_HANDLE_VALUE) {
+    if (fh == INVALID_HANDLE_VALUE) {
+       /* FindFirstFile() fails on empty drives! */
+       if (GetLastError() == ERROR_FILE_NOT_FOUND)
+           return p;
+       Safefree( p);
        return NULL;
     }
 
@@ -537,13 +682,9 @@ opendir(char *filename)
      */
     idx = strlen(FindData.cFileName)+1;
     New(1304, p->start, idx, char);
-    if(p->start == NULL) {
+    if (p->start == NULL)
        croak("opendir: malloc failed!\n");
-    }
     strcpy(p->start, FindData.cFileName);
-/*  if(downcase)
- *     strlwr(p->start);
- */
     p->nfiles++;
 
     /* loop finding all the files that match the wildcard
@@ -557,20 +698,16 @@ opendir(char *filename)
         * new name and it's null terminator
         */
        Renew(p->start, idx+len+1, char);
-       if(p->start == NULL) {
+       if (p->start == NULL)
            croak("opendir: malloc failed!\n");
-       }
        strcpy(&p->start[idx], FindData.cFileName);
-/*     if (downcase) 
- *         strlwr(&p->start[idx]);
- */
-               p->nfiles++;
-               idx += len+1;
-       }
-       FindClose(fh);
-       p->size = idx;
-       p->curr = p->start;
-       return p;
+       p->nfiles++;
+       idx += len+1;
+    }
+    FindClose(fh);
+    p->size = idx;
+    p->curr = p->start;
+    return p;
 }
 
 
@@ -578,7 +715,7 @@ opendir(char *filename)
  * string pointer to the nDllExport entry.
  */
 struct direct *
-readdir(DIR *dirp)
+win32_readdir(DIR *dirp)
 {
     int         len;
     static int  dummy = 0;
@@ -606,7 +743,7 @@ readdir(DIR *dirp)
 
 /* Telldir returns the current string pointer position */
 long
-telldir(DIR *dirp)
+win32_telldir(DIR *dirp)
 {
     return (long) dirp->curr;
 }
@@ -616,21 +753,21 @@ telldir(DIR *dirp)
  *(Saved by telldir).
  */
 void
-seekdir(DIR *dirp, long loc)
+win32_seekdir(DIR *dirp, long loc)
 {
     dirp->curr = (char *)loc;
 }
 
 /* Rewinddir resets the string pointer to the start */
 void
-rewinddir(DIR *dirp)
+win32_rewinddir(DIR *dirp)
 {
     dirp->curr = dirp->start;
 }
 
 /* free the memory allocated by opendir */
 int
-closedir(DIR *dirp)
+win32_closedir(DIR *dirp)
 {
     Safefree(dirp->start);
     Safefree(dirp);
@@ -706,22 +843,44 @@ chown(const char *path, uid_t owner, gid_t group)
     return 0;
 }
 
-int
-kill(int pid, int sig)
+static long
+find_pid(int pid)
 {
-    HANDLE hProcess= OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid);
+    long child;
+    for (child = 0 ; child < w32_num_children ; ++child) {
+       if (w32_child_pids[child] == pid)
+           return child;
+    }
+    return -1;
+}
 
-    if (hProcess == NULL) {
-       croak("kill process failed!\n");
+static void
+remove_dead_process(long child)
+{
+    if (child >= 0) {
+       CloseHandle(w32_child_handles[child]);
+       Copy(&w32_child_handles[child+1], &w32_child_handles[child],
+            (w32_num_children-child-1), HANDLE);
+       Copy(&w32_child_pids[child+1], &w32_child_pids[child],
+            (w32_num_children-child-1), DWORD);
+       w32_num_children--;
     }
-    else {
-       if (!TerminateProcess(hProcess, sig))
-           croak("kill process failed!\n");
+}
+
+DllExport int
+win32_kill(int pid, int sig)
+{
+    HANDLE hProcess;
+    hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid);
+    if (hProcess && TerminateProcess(hProcess, sig))
        CloseHandle(hProcess);
+    else {
+       errno = EINVAL;
+       return -1;
     }
     return 0;
 }
-      
+
 /*
  * File system stuff
  */
@@ -736,7 +895,7 @@ win32_sleep(unsigned int t)
 DllExport int
 win32_stat(const char *path, struct stat *buffer)
 {
-    char               t[MAX_PATH]; 
+    char       t[MAX_PATH+1]; 
     const char *p = path;
     int                l = strlen(path);
     int                res;
@@ -753,8 +912,31 @@ win32_stat(const char *path, struct stat *buffer)
        }
     }
     res = stat(p,buffer);
+    if (res < 0) {
+       /* CRT is buggy on sharenames, so make sure it really isn't.
+        * XXX using GetFileAttributesEx() will enable us to set
+        * buffer->st_*time (but note that's not available on the
+        * Windows of 1995) */
+       DWORD r = GetFileAttributes(p);
+       if (r != 0xffffffff && (r & FILE_ATTRIBUTE_DIRECTORY)) {
+           buffer->st_mode |= S_IFDIR | S_IREAD;
+           errno = 0;
+           if (!(r & FILE_ATTRIBUTE_READONLY))
+               buffer->st_mode |= S_IWRITE | S_IEXEC;
+           return 0;
+       }
+    }
+    else {
+       if (l == 3 && path[l-2] == ':'
+           && (path[l-1] == '\\' || path[l-1] == '/'))
+       {
+           /* The drive can be inaccessible, some _stat()s are buggy */
+           if (!GetVolumeInformation(path,NULL,0,NULL,NULL,NULL,NULL,0)) {
+               errno = ENOENT;
+               return -1;
+           }
+       }
 #ifdef __BORLANDC__
-    if (res == 0) {
        if (S_ISDIR(buffer->st_mode))
            buffer->st_mode |= S_IWRITE | S_IEXEC;
        else if (S_ISREG(buffer->st_mode)) {
@@ -771,8 +953,8 @@ win32_stat(const char *path, struct stat *buffer)
            else
                buffer->st_mode &= ~S_IEXEC;
        }
-    }
 #endif
+    }
     return res;
 }
 
@@ -781,21 +963,77 @@ win32_stat(const char *path, struct stat *buffer)
 DllExport char *
 win32_getenv(const char *name)
 {
-    static char *curitem = Nullch;
-    static DWORD curlen = 512;
+    static char *curitem = Nullch;     /* XXX threadead */
+    static DWORD curlen = 0;           /* XXX threadead */
     DWORD needlen;
-    if (!curitem)
+    if (!curitem) {
+       curlen = 512;
        New(1305,curitem,curlen,char);
-    if (!(needlen = GetEnvironmentVariable(name,curitem,curlen)))
-       return Nullch;
-    while (needlen > curlen) {
-       Renew(curitem,needlen,char);
-       curlen = needlen;
-       needlen = GetEnvironmentVariable(name,curitem,curlen);
     }
+
+    needlen = GetEnvironmentVariable(name,curitem,curlen);
+    if (needlen != 0) {
+       while (needlen > curlen) {
+           Renew(curitem,needlen,char);
+           curlen = needlen;
+           needlen = GetEnvironmentVariable(name,curitem,curlen);
+       }
+    }
+    else {
+       /* allow any environment variables that begin with 'PERL'
+          to be stored in the registry */
+       if (curitem)
+           *curitem = '\0';
+
+       if (strncmp(name, "PERL", 4) == 0) {
+           if (curitem) {
+               Safefree(curitem);
+               curitem = Nullch;
+               curlen = 0;
+           }
+           curitem = GetRegStr(name, &curitem, &curlen);
+       }
+    }
+    if (curitem && *curitem == '\0')
+       return Nullch;
+
     return curitem;
 }
 
+DllExport int
+win32_putenv(const char *name)
+{
+    char* curitem;
+    char* val;
+    int relval = -1;
+    if(name) {
+       New(1309,curitem,strlen(name)+1,char);
+       strcpy(curitem, name);
+       val = strchr(curitem, '=');
+       if(val) {
+           /* The sane way to deal with the environment.
+            * Has these advantages over putenv() & co.:
+            *  * enables us to store a truly empty value in the
+            *    environment (like in UNIX).
+            *  * we don't have to deal with RTL globals, bugs and leaks.
+            *  * Much faster.
+            * Why you may want to enable USE_WIN32_RTL_ENV:
+            *  * environ[] and RTL functions will not reflect changes,
+            *    which might be an issue if extensions want to access
+            *    the env. via RTL.  This cuts both ways, since RTL will
+            *    not see changes made by extensions that call the Win32
+            *    functions directly, either.
+            * GSAR 97-06-07
+            */
+           *val++ = '\0';
+           if(SetEnvironmentVariable(curitem, *val ? val : NULL))
+               relval = 0;
+       }
+       Safefree(curitem);
+    }
+    return relval;
+}
+
 #endif
 
 static long
@@ -895,11 +1133,42 @@ win32_utime(const char *filename, struct utimbuf *times)
 }
 
 DllExport int
+win32_waitpid(int pid, int *status, int flags)
+{
+    int retval = -1;
+    if (pid == -1) 
+       return win32_wait(status);
+    else {
+       long child = find_pid(pid);
+       if (child >= 0) {
+           HANDLE hProcess = w32_child_handles[child];
+           DWORD waitcode = WaitForSingleObject(hProcess, INFINITE);
+           if (waitcode != WAIT_FAILED) {
+               if (GetExitCodeProcess(hProcess, &waitcode)) {
+                   *status = (int)((waitcode & 0xff) << 8);
+                   retval = (int)w32_child_pids[child];
+                   remove_dead_process(child);
+                   return retval;
+               }
+           }
+           else
+               errno = ECHILD;
+       }
+       else {
+           retval = cwait(status, pid, WAIT_CHILD);
+           /* cwait() returns "correctly" on Borland */
+#ifndef __BORLANDC__
+           if (status)
+               *status *= 256;
+#endif
+       }
+    }
+    return retval >= 0 ? pid : retval;                
+}
+
+DllExport int
 win32_wait(int *status)
 {
-#ifdef __BORLANDC__
-    return wait(status);
-#else
     /* XXX this wait emulation only knows about processes
      * spawned via win32_spawnvp(P_NOWAIT, ...).
      */
@@ -913,7 +1182,7 @@ win32_wait(int *status)
 
     /* if a child exists, wait for it to die */
     waitcode = WaitForMultipleObjects(w32_num_children,
-                                     w32_child_pids,
+                                     w32_child_handles,
                                      FALSE,
                                      INFINITE);
     if (waitcode != WAIT_FAILED) {
@@ -922,13 +1191,10 @@ win32_wait(int *status)
            i = waitcode - WAIT_ABANDONED_0;
        else
            i = waitcode - WAIT_OBJECT_0;
-       if (GetExitCodeProcess(w32_child_pids[i], &exitcode) ) {
-           CloseHandle(w32_child_pids[i]);
+       if (GetExitCodeProcess(w32_child_handles[i], &exitcode) ) {
            *status = (int)((exitcode & 0xff) << 8);
            retval = (int)w32_child_pids[i];
-           Copy(&w32_child_pids[i+1], &w32_child_pids[i],
-                (w32_num_children-i-1), HANDLE);
-           w32_num_children--;
+           remove_dead_process(i);
            return retval;
        }
     }
@@ -936,8 +1202,6 @@ win32_wait(int *status)
 FAILED:
     errno = GetLastError();
     return -1;
-
-#endif
 }
 
 static UINT timerid = 0;
@@ -978,14 +1242,21 @@ win32_alarm(unsigned int sec)
     return 0;
 }
 
+#if defined(HAVE_DES_FCRYPT) || defined(PERL_OBJECT)
 #ifdef HAVE_DES_FCRYPT
-extern char *  des_fcrypt(char *cbuf, const char *txt, const char *salt);
+extern char *  des_fcrypt(const char *txt, const char *salt, char *cbuf);
+#endif
 
 DllExport char *
 win32_crypt(const char *txt, const char *salt)
 {
+#ifdef HAVE_DES_FCRYPT
     dTHR;
-    return des_fcrypt(crypt_buffer, txt, salt);
+    return des_fcrypt(txt, salt, crypt_buffer);
+#else
+    die("The crypt() function is unimplemented due to excessive paranoia.");
+    return Nullch;
+#endif
 }
 #endif
 
@@ -1058,14 +1329,14 @@ my_open_osfhandle(long osfhandle, int flags)
     /* copy relevant flags from second parameter */
     fileflags = FDEV;
 
-    if(flags & O_APPEND)
+    if (flags & O_APPEND)
        fileflags |= FAPPEND;
 
-    if(flags & O_TEXT)
+    if (flags & O_TEXT)
        fileflags |= FTEXT;
 
     /* attempt to allocate a C Runtime file handle */
-    if((fh = _alloc_osfhnd()) == -1) {
+    if ((fh = _alloc_osfhnd()) == -1) {
        errno = EMFILE;         /* too many open files */
        _doserrno = 0L;         /* not an OS error */
        return -1;              /* return error to caller */
@@ -1200,12 +1471,12 @@ win32_strerror(int e)
 #endif
     DWORD source = 0;
 
-    if(e < 0 || e > sys_nerr) {
+    if (e < 0 || e > sys_nerr) {
         dTHR;
-       if(e < 0)
+       if (e < 0)
            e = GetLastError();
 
-       if(FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0,
+       if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0,
                         strerror_buffer, sizeof(strerror_buffer), NULL) == 0) 
            strcpy(strerror_buffer, "Unknown Error");
 
@@ -1231,7 +1502,7 @@ win32_str_os_error(void *sv, DWORD dwErr)
        sMsg[dwLen]= '\0';
     }
     if (0 == dwLen) {
-       sMsg = LocalAlloc(0, 64/**sizeof(TCHAR)*/);
+       sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/);
        dwLen = sprintf(sMsg,
                        "Unknown error #0x%lX (lookup 0x%lX)",
                        dwErr, GetLastError());
@@ -1422,7 +1693,7 @@ win32_pipe(int *pfd, unsigned int size, int mode)
 DllExport FILE*
 win32_popen(const char *command, const char *mode)
 {
-#ifdef USE_CRT_POPEN
+#ifdef USE_RTL_POPEN
     return _popen(command, mode);
 #else
     int p[2];
@@ -1482,7 +1753,7 @@ win32_popen(const char *command, const char *mode)
     /* close saved handle */
     win32_close(oldfd);
 
-    w32_popen_pids[p[parent]] = childpid;
+    sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
 
     /* we have an fd, return a file stream */
     return (win32_fdopen(p[parent], (char *)mode));
@@ -1497,7 +1768,7 @@ cleanup:
     }
     return (NULL);
 
-#endif /* USE_CRT_POPEN */
+#endif /* USE_RTL_POPEN */
 }
 
 /*
@@ -1507,13 +1778,18 @@ cleanup:
 DllExport int
 win32_pclose(FILE *pf)
 {
-#ifdef USE_CRT_POPEN
+#ifdef USE_RTL_POPEN
     return _pclose(pf);
 #else
-    int fd, childpid, status;
 
-    fd = win32_fileno(pf);
-    childpid = w32_popen_pids[fd];
+    int childpid, status;
+    SV *sv;
+
+    sv = *av_fetch(w32_fdpid, win32_fileno(pf), TRUE);
+    if (SvIOK(sv))
+       childpid = SvIVX(sv);
+    else
+       childpid = 0;
 
     if (!childpid) {
        errno = EBADF;
@@ -1521,19 +1797,115 @@ win32_pclose(FILE *pf)
     }
 
     win32_fclose(pf);
-    w32_popen_pids[fd] = 0;
+    SvIVX(sv) = 0;
 
-    /* wait for the child */
-    if (cwait(&status, childpid, WAIT_CHILD) == -1)
-        return (-1);
-    /* cwait() returns differently on Borland */
-#ifdef __BORLANDC__
-    return (((status >> 8) & 0xff) | ((status << 8) & 0xff00));
-#else
-    return (status);
-#endif
+    if (win32_waitpid(childpid, &status, 0) == -1)
+        return -1;
+
+    return status;
+
+#endif /* USE_RTL_POPEN */
+}
+
+DllExport int
+win32_rename(const char *oname, const char *newname)
+{
+    /* XXX despite what the documentation says about MoveFileEx(),
+     * it doesn't work under Windows95!
+     */
+    if (IsWinNT()) {
+       if (!MoveFileEx(oname,newname,
+                       MOVEFILE_COPY_ALLOWED|MOVEFILE_REPLACE_EXISTING)) {
+           DWORD err = GetLastError();
+           switch (err) {
+           case ERROR_BAD_NET_NAME:
+           case ERROR_BAD_NETPATH:
+           case ERROR_BAD_PATHNAME:
+           case ERROR_FILE_NOT_FOUND:
+           case ERROR_FILENAME_EXCED_RANGE:
+           case ERROR_INVALID_DRIVE:
+           case ERROR_NO_MORE_FILES:
+           case ERROR_PATH_NOT_FOUND:
+               errno = ENOENT;
+               break;
+           default:
+               errno = EACCES;
+               break;
+           }
+           return -1;
+       }
+       return 0;
+    }
+    else {
+       int retval = 0;
+       char tmpname[MAX_PATH+1];
+       char dname[MAX_PATH+1];
+       char *endname = Nullch;
+       STRLEN tmplen = 0;
+       DWORD from_attr, to_attr;
+
+       /* if oname doesn't exist, do nothing */
+       from_attr = GetFileAttributes(oname);
+       if (from_attr == 0xFFFFFFFF) {
+           errno = ENOENT;
+           return -1;
+       }
+
+       /* if newname exists, rename it to a temporary name so that we
+        * don't delete it in case oname happens to be the same file
+        * (but perhaps accessed via a different path)
+        */
+       to_attr = GetFileAttributes(newname);
+       if (to_attr != 0xFFFFFFFF) {
+           /* if newname is a directory, we fail
+            * XXX could overcome this with yet more convoluted logic */
+           if (to_attr & FILE_ATTRIBUTE_DIRECTORY) {
+               errno = EACCES;
+               return -1;
+           }
+           tmplen = strlen(newname);
+           strcpy(tmpname,newname);
+           endname = tmpname+tmplen;
+           for (; endname > tmpname ; --endname) {
+               if (*endname == '/' || *endname == '\\') {
+                   *endname = '\0';
+                   break;
+               }
+           }
+           if (endname > tmpname)
+               endname = strcpy(dname,tmpname);
+           else
+               endname = ".";
+
+           /* get a temporary filename in same directory
+            * XXX is this really the best we can do? */
+           if (!GetTempFileName((LPCTSTR)endname, "plr", 0, tmpname)) {
+               errno = ENOENT;
+               return -1;
+           }
+           DeleteFile(tmpname);
+
+           retval = rename(newname, tmpname);
+           if (retval != 0) {
+               errno = EACCES;
+               return retval;
+           }
+       }
+
+       /* rename oname to newname */
+       retval = rename(oname, newname);
 
-#endif /* USE_CRT_OPEN */
+       /* if we created a temporary file before ... */
+       if (endname != Nullch) {
+           /* ...and rename succeeded, delete temporary file/directory */
+           if (retval == 0)
+               DeleteFile(tmpname);
+           /* else restore it to what it was */
+           else
+               (void)rename(tmpname, newname);
+       }
+       return retval;
+    }
 }
 
 DllExport int
@@ -1623,21 +1995,218 @@ win32_chdir(const char *dir)
     return chdir(dir);
 }
 
+static char *
+create_command_line(const char* command, const char * const *args)
+{
+    int index;
+    char *cmd, *ptr, *arg;
+    STRLEN len = strlen(command) + 1;
+
+    for (index = 0; (ptr = (char*)args[index]) != NULL; ++index)
+       len += strlen(ptr) + 1;
+
+    New(1310, cmd, len, char);
+    ptr = cmd;
+    strcpy(ptr, command);
+    ptr += strlen(ptr);
+    *ptr++ = ' ';
+
+    for (index = 0; (arg = (char*)args[index]) != NULL; ++index) {
+       strcpy(ptr, arg);
+       ptr += strlen(ptr);
+       if ((char*)args[index+1] != NULL)
+           *ptr++ = ' ';
+    }
+
+    return cmd;
+}
+
+static char *
+qualified_path(const char *cmd)
+{
+    char *pathstr;
+    char *fullcmd, *curfullcmd;
+    STRLEN cmdlen = 0;
+    int has_slash = 0;
+
+    if (!cmd)
+       return Nullch;
+    fullcmd = (char*)cmd;
+    while (*fullcmd) {
+       if (*fullcmd == '/' || *fullcmd == '\\')
+           has_slash++;
+       fullcmd++;
+       cmdlen++;
+    }
+
+    /* look in PATH */
+    pathstr = win32_getenv("PATH");
+    New(0, fullcmd, MAX_PATH+1, char);
+    curfullcmd = fullcmd;
+
+    while (1) {
+       DWORD res;
+
+       /* start by appending the name to the current prefix */
+       strcpy(curfullcmd, cmd);
+       curfullcmd += cmdlen;
+
+       /* if it doesn't end with '.', or has no extension, try adding
+        * a trailing .exe first */
+       if (cmd[cmdlen-1] != '.'
+           && (cmdlen < 4 || cmd[cmdlen-4] != '.'))
+       {
+           strcpy(curfullcmd, ".exe");
+           res = GetFileAttributes(fullcmd);
+           if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY))
+               return fullcmd;
+           *curfullcmd = '\0';
+       }
+
+       /* that failed, try the bare name */
+       res = GetFileAttributes(fullcmd);
+       if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY))
+           return fullcmd;
+
+       /* quit if no other path exists, or if cmd already has path */
+       if (!pathstr || !*pathstr || has_slash)
+           break;
+
+       /* skip leading semis */
+       while (*pathstr == ';')
+           pathstr++;
+
+       /* build a new prefix from scratch */
+       curfullcmd = fullcmd;
+       while (*pathstr && *pathstr != ';') {
+           if (*pathstr == '"') {      /* foo;"baz;etc";bar */
+               pathstr++;              /* skip initial '"' */
+               while (*pathstr && *pathstr != '"') {
+                   if (curfullcmd-fullcmd < MAX_PATH-cmdlen-5)
+                       *curfullcmd++ = *pathstr;
+                   pathstr++;
+               }
+               if (*pathstr)
+                   pathstr++;          /* skip trailing '"' */
+           }
+           else {
+               if (curfullcmd-fullcmd < MAX_PATH-cmdlen-5)
+                   *curfullcmd++ = *pathstr;
+               pathstr++;
+           }
+       }
+       if (*pathstr)
+           pathstr++;                  /* skip trailing semi */
+       if (curfullcmd > fullcmd        /* append a dir separator */
+           && curfullcmd[-1] != '/' && curfullcmd[-1] != '\\')
+       {
+           *curfullcmd++ = '\\';
+       }
+    }
+GIVE_UP:
+    Safefree(fullcmd);
+    return Nullch;
+}
+
+/* XXX this needs to be made more compatible with the spawnvp()
+ * provided by the various RTLs.  In particular, searching for
+ * *.{com,bat,cmd} files (as done by the RTLs) is unimplemented.
+ * This doesn't significantly affect perl itself, because we
+ * always invoke things using PERL5SHELL if a direct attempt to
+ * spawn the executable fails.
+ * 
+ * XXX splitting and rejoining the commandline between do_aspawn()
+ * and win32_spawnvp() could also be avoided.
+ */
+
 DllExport int
 win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
 {
-    int status;
+#ifdef USE_RTL_SPAWNVP
+    return spawnvp(mode, cmdname, (char * const *)argv);
+#else
+    DWORD ret;
+    STARTUPINFO StartupInfo;
+    PROCESS_INFORMATION ProcessInformation;
+    DWORD create = 0;
+
+    char *cmd = create_command_line(cmdname, strcmp(cmdname, argv[0]) == 0
+                                            ? &argv[1] : argv);
+    char *fullcmd = Nullch;
+
+    switch(mode) {
+    case P_NOWAIT:     /* asynch + remember result */
+       if (w32_num_children >= MAXIMUM_WAIT_OBJECTS) {
+           errno = EAGAIN;
+           ret = -1;
+           goto RETVAL;
+       }
+       /* FALL THROUGH */
+    case P_WAIT:       /* synchronous execution */
+       break;
+    default:           /* invalid mode */
+       errno = EINVAL;
+       ret = -1;
+       goto RETVAL;
+    }
+    memset(&StartupInfo,0,sizeof(StartupInfo));
+    StartupInfo.cb = sizeof(StartupInfo);
+    StartupInfo.wShowWindow = SW_SHOWDEFAULT;
+
+RETRY:
+    if (!CreateProcess(cmdname,                /* search PATH to find executable */
+                      cmd,             /* executable, and its arguments */
+                      NULL,            /* process attributes */
+                      NULL,            /* thread attributes */
+                      TRUE,            /* inherit handles */
+                      create,          /* creation flags */
+                      NULL,            /* inherit environment */
+                      NULL,            /* inherit cwd */
+                      &StartupInfo,
+                      &ProcessInformation))
+    {
+       /* initial NULL argument to CreateProcess() does a PATH
+        * search, but it always first looks in the directory
+        * where the current process was started, which behavior
+        * is undesirable for backward compatibility.  So we
+        * jump through our own hoops by picking out the path
+        * we really want it to use. */
+       if (!fullcmd) {
+           fullcmd = qualified_path(cmdname);
+           if (fullcmd) {
+               cmdname = fullcmd;
+               goto RETRY;
+           }
+       }
+       errno = ENOENT;
+       ret = -1;
+       goto RETVAL;
+    }
 
-    status = spawnvp(mode, cmdname, (char * const *) argv);
-#ifndef __BORLANDC__
-    /* XXX For the P_NOWAIT case, Borland RTL returns pinfo.dwProcessId
-     * while VC RTL returns pinfo.hProcess. For purposes of the custom
-     * implementation of win32_wait(), we assume the latter.
-     */
-    if (mode == P_NOWAIT && status >= 0)
-       w32_child_pids[w32_num_children++] = (HANDLE)status;
+    if (mode == P_NOWAIT) {
+       /* asynchronous spawn -- store handle, return PID */
+       w32_child_handles[w32_num_children] = ProcessInformation.hProcess;
+       ret = w32_child_pids[w32_num_children] = ProcessInformation.dwProcessId;
+       ++w32_num_children;
+    }
+    else  {
+       WaitForSingleObject(ProcessInformation.hProcess, INFINITE);
+       GetExitCodeProcess(ProcessInformation.hProcess, &ret);
+       CloseHandle(ProcessInformation.hProcess);
+    }
+
+    CloseHandle(ProcessInformation.hThread);
+RETVAL:
+    Safefree(cmd);
+    Safefree(fullcmd);
+    return (int)ret;
 #endif
-    return status;
+}
+
+DllExport int
+win32_execv(const char *cmdname, const char *const *argv)
+{
+    return execv(cmdname, (char *const *)argv);
 }
 
 DllExport int
@@ -1853,11 +2422,13 @@ XS(w32_GetCwd)
      *   then it worked, set PV valid, 
      *   else leave it 'undef' 
      */
-    if (SvCUR(sv))
-       SvPOK_on(sv);
     EXTEND(SP,1);
-    ST(0) = sv;
-    XSRETURN(1);
+    if (SvCUR(sv)) {
+       SvPOK_on(sv);
+       ST(0) = sv;
+       XSRETURN(1);
+    }
+    XSRETURN_UNDEF;
 }
 
 static
@@ -1866,7 +2437,7 @@ XS(w32_SetCwd)
     dXSARGS;
     if (items != 1)
        croak("usage: Win32::SetCurrentDirectory($cwd)");
-    if (SetCurrentDirectory(SvPV(ST(0),na)))
+    if (SetCurrentDirectory(SvPV_nolen(ST(0))))
        XSRETURN_YES;
 
     XSRETURN_NO;
@@ -1878,6 +2449,8 @@ XS(w32_GetNextAvailDrive)
     dXSARGS;
     char ix = 'C';
     char root[] = "_:\\";
+
+    EXTEND(SP,1);
     while (ix <= 'Z') {
        root[0] = ix++;
        if (GetDriveType(root) == 1) {
@@ -1892,15 +2465,27 @@ static
 XS(w32_GetLastError)
 {
     dXSARGS;
+    EXTEND(SP,1);
     XSRETURN_IV(GetLastError());
 }
 
 static
+XS(w32_SetLastError)
+{
+    dXSARGS;
+    if (items != 1)
+       croak("usage: Win32::SetLastError($error)");
+    SetLastError(SvIV(ST(0)));
+    XSRETURN_EMPTY;
+}
+
+static
 XS(w32_LoginName)
 {
     dXSARGS;
     char *name = getlogin_buffer;
     DWORD size = sizeof(getlogin_buffer);
+    EXTEND(SP,1);
     if (GetUserName(name,&size)) {
        /* size includes NULL */
        ST(0) = sv_2mortal(newSVpv(name,size-1));
@@ -1915,6 +2500,7 @@ XS(w32_NodeName)
     dXSARGS;
     char name[MAX_COMPUTERNAME_LENGTH+1];
     DWORD size = sizeof(name);
+    EXTEND(SP,1);
     if (GetComputerName(name,&size)) {
        /* size does NOT include NULL :-( */
        ST(0) = sv_2mortal(newSVpv(name,size));
@@ -1928,19 +2514,43 @@ static
 XS(w32_DomainName)
 {
     dXSARGS;
+#ifndef HAS_NETWKSTAGETINFO
+    /* mingw32 (and Win95) don't have NetWksta*(), so do it the old way */
     char name[256];
     DWORD size = sizeof(name);
+    EXTEND(SP,1);
     if (GetUserName(name,&size)) {
        char sid[1024];
        DWORD sidlen = sizeof(sid);
        char dname[256];
        DWORD dnamelen = sizeof(dname);
        SID_NAME_USE snu;
-       if (LookupAccountName(NULL, name, &sid, &sidlen,
+       if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen,
                              dname, &dnamelen, &snu)) {
            XSRETURN_PV(dname);         /* all that for this */
        }
     }
+#else
+    /* this way is more reliable, in case user has a local account.
+     * XXX need dynamic binding of netapi32.dll symbols or this will fail on
+     * Win95. Probably makes more sense to move it into libwin32. */
+    char dname[256];
+    DWORD dnamelen = sizeof(dname);
+    PWKSTA_INFO_100 pwi;
+    EXTEND(SP,1);
+    if (NERR_Success == NetWkstaGetInfo(NULL, 100, (LPBYTE*)&pwi)) {
+       if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
+           WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_langroup,
+                               -1, (LPSTR)dname, dnamelen, NULL, NULL);
+       }
+       else {
+           WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_computername,
+                               -1, (LPSTR)dname, dnamelen, NULL, NULL);
+       }
+       NetApiBufferFree(pwi);
+       XSRETURN_PV(dname);
+    }
+#endif
     XSRETURN_UNDEF;
 }
 
@@ -1952,16 +2562,17 @@ XS(w32_FsType)
     DWORD flags, filecomplen;
     if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
                         &flags, fsname, sizeof(fsname))) {
-       if (GIMME == G_ARRAY) {
+       if (GIMME_V == G_ARRAY) {
            XPUSHs(sv_2mortal(newSVpv(fsname,0)));
            XPUSHs(sv_2mortal(newSViv(flags)));
            XPUSHs(sv_2mortal(newSViv(filecomplen)));
            PUTBACK;
            return;
        }
+       EXTEND(SP,1);
        XSRETURN_PV(fsname);
     }
-    XSRETURN_UNDEF;
+    XSRETURN_EMPTY;
 }
 
 static
@@ -1980,13 +2591,14 @@ XS(w32_GetOSVersion)
        PUTBACK;
        return;
     }
-    XSRETURN_UNDEF;
+    XSRETURN_EMPTY;
 }
 
 static
 XS(w32_IsWinNT)
 {
     dXSARGS;
+    EXTEND(SP,1);
     XSRETURN_IV(IsWinNT());
 }
 
@@ -1994,6 +2606,7 @@ static
 XS(w32_IsWin95)
 {
     dXSARGS;
+    EXTEND(SP,1);
     XSRETURN_IV(IsWin95());
 }
 
@@ -2024,18 +2637,18 @@ XS(w32_Spawn)
     STARTUPINFO stStartInfo;
     BOOL bSuccess = FALSE;
 
-    if(items != 3)
+    if (items != 3)
        croak("usage: Win32::Spawn($cmdName, $args, $PID)");
 
-    cmd = SvPV(ST(0),na);
-    args = SvPV(ST(1), na);
+    cmd = SvPV_nolen(ST(0));
+    args = SvPV_nolen(ST(1));
 
     memset(&stStartInfo, 0, sizeof(stStartInfo));   /* Clear the block */
     stStartInfo.cb = sizeof(stStartInfo);          /* Set the structure size */
     stStartInfo.dwFlags = STARTF_USESHOWWINDOW;            /* Enable wShowWindow control */
     stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE;   /* Start min (normal) */
 
-    if(CreateProcess(
+    if (CreateProcess(
                cmd,                    /* Image path */
                args,                   /* Arguments for command line */
                NULL,                   /* Default process security */
@@ -2058,6 +2671,7 @@ static
 XS(w32_GetTickCount)
 {
     dXSARGS;
+    EXTEND(SP,1);
     XSRETURN_IV(GetTickCount());
 }
 
@@ -2068,7 +2682,7 @@ XS(w32_GetShortPathName)
     SV *shortpath;
     DWORD len;
 
-    if(items != 1)
+    if (items != 1)
        croak("usage: Win32::GetShortPathName($longPathName)");
 
     shortpath = sv_mortalcopy(ST(0));
@@ -2082,10 +2696,44 @@ XS(w32_GetShortPathName)
     if (len) {
        SvCUR_set(shortpath,len);
        ST(0) = shortpath;
+       XSRETURN(1);
     }
-    else
-       ST(0) = &sv_undef;
-    XSRETURN(1);
+    XSRETURN_UNDEF;
+}
+
+static
+XS(w32_GetFullPathName)
+{
+    dXSARGS;
+    SV *filename;
+    SV *fullpath;
+    char *filepart;
+    DWORD len;
+
+    if (items != 1)
+       croak("usage: Win32::GetFullPathName($filename)");
+
+    filename = ST(0);
+    fullpath = sv_mortalcopy(filename);
+    SvUPGRADE(fullpath, SVt_PV);
+    do {
+       len = GetFullPathName(SvPVX(filename),
+                             SvLEN(fullpath),
+                             SvPVX(fullpath),
+                             &filepart);
+    } while (len >= SvLEN(fullpath) && sv_grow(fullpath,len+1));
+    if (len) {
+       if (GIMME_V == G_ARRAY) {
+           EXTEND(SP,1);
+           XST_mPV(1,filepart);
+           len = filepart - SvPVX(fullpath);
+           items = 2;
+       }
+       SvCUR_set(fullpath,len);
+       ST(0) = fullpath;
+       XSRETURN(items);
+    }
+    XSRETURN_EMPTY;
 }
 
 static
@@ -2104,11 +2752,18 @@ Perl_init_os_extras()
     char *file = __FILE__;
     dXSUB_SYS;
 
+    w32_perlshell_tokens = Nullch;
+    w32_perlshell_items = -1;
+    w32_fdpid = newAV();               /* XXX needs to be in Perl_win32_init()? */
+    New(1313, w32_children, 1, child_tab);
+    w32_num_children = 0;
+
     /* these names are Activeware compatible */
     newXS("Win32::GetCwd", w32_GetCwd, file);
     newXS("Win32::SetCwd", w32_SetCwd, file);
     newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
     newXS("Win32::GetLastError", w32_GetLastError, file);
+    newXS("Win32::SetLastError", w32_SetLastError, file);
     newXS("Win32::LoginName", w32_LoginName, file);
     newXS("Win32::NodeName", w32_NodeName, file);
     newXS("Win32::DomainName", w32_DomainName, file);
@@ -2120,6 +2775,7 @@ Perl_init_os_extras()
     newXS("Win32::Spawn", w32_Spawn, file);
     newXS("Win32::GetTickCount", w32_GetTickCount, file);
     newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
+    newXS("Win32::GetFullPathName", w32_GetFullPathName, file);
     newXS("Win32::Sleep", w32_Sleep, file);
 
     /* XXX Bloat Alert! The following Activeware preloads really
@@ -2146,7 +2802,7 @@ Perl_win32_init(int *argcp, char ***argvp)
 #if !defined(_ALPHA_) && !defined(__GNUC__)
     _control87(MCW_EM, MCW_EM);
 #endif
-    MALLOC_INIT; 
+    MALLOC_INIT;
 }
 
 #ifdef USE_BINMODE_SCRIPTS