minor cleanup
[p5sagit/p5-mst-13.2.git] / win32 / win32.c
index a20fc61..5f7d487 100644 (file)
 #include <tchar.h>
 #ifdef __GNUC__
 #define Win32_Winsock
-#  ifdef __cplusplus
-#undef __attribute__           /* seems broken in 2.8.0 */
-#define __attribute__(p)
-#  endif
 #endif
 #include <windows.h>
 
@@ -87,18 +83,6 @@ int _CRT_glob = 0;
 #define do_spawn g_do_spawn
 #undef do_exec
 #define do_exec g_do_exec
-#undef opendir
-#define opendir g_opendir
-#undef readdir
-#define readdir g_readdir
-#undef telldir
-#define telldir g_telldir
-#undef seekdir
-#define seekdir g_seekdir
-#undef rewinddir
-#define rewinddir g_rewinddir
-#undef closedir
-#define closedir g_closedir
 #undef getlogin
 #define getlogin g_getlogin
 #endif
@@ -107,10 +91,11 @@ static DWORD               os_id(void);
 static void            get_shell(void);
 static long            tokenize(char *str, char **dest, char ***destv);
        int             do_spawn2(char *cmd, int exectype);
-static BOOL            has_redirection(char *ptr);
+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(HANDLE deceased);
 
 HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE;
 static DWORD   w32_platform = (DWORD)-1;
@@ -160,7 +145,7 @@ GetRegStrFromKey(HKEY hkey, const char *lpszValueName, char** ptr, DWORD* lpData
     if (retval == ERROR_SUCCESS){
        retval = RegQueryValueEx(handle, lpszValueName, 0, &type, NULL, lpDataLen);
        if (retval == ERROR_SUCCESS && type == REG_SZ) {
-           if (*ptr != NULL) {
+           if (*ptr) {
                Renew(*ptr, *lpDataLen, char);
            }
            else {
@@ -169,7 +154,7 @@ GetRegStrFromKey(HKEY hkey, const char *lpszValueName, char** ptr, DWORD* lpData
            retval = RegQueryValueEx(handle, lpszValueName, 0, NULL, (PBYTE)*ptr, lpDataLen);
            if (retval != ERROR_SUCCESS) {
                Safefree(*ptr);
-               *ptr = NULL;
+               *ptr = Nullch;
            }
        }
        RegCloseKey(handle);
@@ -181,7 +166,7 @@ char*
 GetRegStr(const char *lpszValueName, char** ptr, DWORD* lpDataLen)
 {
     *ptr = GetRegStrFromKey(HKEY_CURRENT_USER, lpszValueName, ptr, lpDataLen);
-    if (*ptr == NULL)
+    if (*ptr == Nullch)
     {
        *ptr = GetRegStrFromKey(HKEY_LOCAL_MACHINE, lpszValueName, ptr, lpDataLen);
     }
@@ -192,7 +177,7 @@ static char *
 get_emd_part(char *prev_path, char *trailing_path, ...)
 {
     va_list ap;
-    char mod_name[MAX_PATH];
+    char mod_name[MAX_PATH+1];
     char *ptr;
     char *optr;
     char *strip;
@@ -201,7 +186,9 @@ get_emd_part(char *prev_path, char *trailing_path, ...)
     va_start(ap, trailing_path);
     strip = va_arg(ap, char *);
 
-    GetModuleFileName(GetModuleHandle(NULL), mod_name, sizeof(mod_name));
+    GetModuleFileName((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 */
@@ -227,7 +214,7 @@ get_emd_part(char *prev_path, char *trailing_path, ...)
        oldsize = strlen(prev_path) + 1;
        newsize += oldsize;                     /* includes plus 1 for ';' */
        Renew(prev_path, newsize, char);
-       prev_path[oldsize] = ';';
+       prev_path[oldsize-1] = ';';
        strcpy(&prev_path[oldsize], mod_name);
     }
     else {
@@ -249,7 +236,7 @@ win32_get_privlib(char *pl)
     /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || "";  */
     sprintf(buffer, "%s-%s", stdlib, pl);
     path = GetRegStr(buffer, &path, &datalen);
-    if (path == NULL)
+    if (!path)
        path = GetRegStr(stdlib, &path, &datalen);
 
     /* $stdlib .= ";$EMD/../../lib" */
@@ -261,7 +248,7 @@ win32_get_sitelib(char *pl)
 {
     char *sitelib = "sitelib";
     char regstr[40];
-    char pathstr[MAX_PATH];
+    char pathstr[MAX_PATH+1];
     DWORD datalen;
     char *path1 = Nullch;
     char *path2 = Nullch;
@@ -302,17 +289,20 @@ win32_get_sitelib(char *pl)
 
 
 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) {
        switch(*ptr) {
+       case '%':
+           return TRUE;
        case '\'':
        case '\"':
            if (inquote) {
@@ -483,7 +473,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
     }
 
     while (++mark <= sp) {
-       if (*mark && (str = SvPV(*mark, na)))
+       if (*mark && (str = SvPV(*mark, PL_na)))
            argv[index++] = str;
        else
            argv[index++] = "";
@@ -491,7 +481,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
     argv[index++] = 0;
    
     status = win32_spawnvp(flag,
-                          (const char*)(really ? SvPV(really,na) : argv[0]),
+                          (const char*)(really ? SvPV(really,PL_na) : argv[0]),
                           (const char* const*)argv);
 
     if (status < 0 && errno == ENOEXEC) {
@@ -504,19 +494,19 @@ do_aspawn(void *vreally, void **vmark, void **vsp)
            argv[sh_items] = w32_perlshell_vec[sh_items];
    
        status = win32_spawnvp(flag,
-                              (const char*)(really ? SvPV(really,na) : argv[0]),
+                              (const char*)(really ? SvPV(really,PL_na) : 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);
@@ -534,7 +524,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);
@@ -597,7 +587,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));
@@ -605,7 +595,7 @@ do_spawn2(char *cmd, int exectype)
        }
        else
            status *= 256;
-       statusvalue = status;
+       PL_statusvalue = status;
     }
     return (status);
 }
@@ -634,7 +624,7 @@ do_exec(char *cmd)
  * return the pointer to the current file name.
  */
 DIR *
-opendir(char *filename)
+win32_opendir(char *filename)
 {
     DIR                        *p;
     long               len;
@@ -649,12 +639,8 @@ opendir(char *filename)
        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;
-    }
+    if (win32_stat(filename, &sbuf) < 0 || !S_ISDIR(sbuf.st_mode))
+       return NULL;
 
     /* Get us a DIR structure */
     Newz(1303, p, 1, DIR);
@@ -712,7 +698,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;
@@ -740,7 +726,7 @@ readdir(DIR *dirp)
 
 /* Telldir returns the current string pointer position */
 long
-telldir(DIR *dirp)
+win32_telldir(DIR *dirp)
 {
     return (long) dirp->curr;
 }
@@ -750,21 +736,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);
@@ -840,10 +826,30 @@ chown(const char *path, uid_t owner, gid_t group)
     return 0;
 }
 
-int
-kill(int pid, int sig)
+static void
+remove_dead_process(HANDLE deceased)
+{
+#ifndef USE_RTL_WAIT
+    int child;
+    for (child = 0 ; child < w32_num_children ; ++child) {
+       if (w32_child_pids[child] == deceased) {
+           Copy(&w32_child_pids[child+1], &w32_child_pids[child],
+                (w32_num_children-child-1), HANDLE);
+           w32_num_children--;
+           break;
+       }
+    }
+#endif
+}
+
+DllExport int
+win32_kill(int pid, int sig)
 {
+#ifdef USE_RTL_WAIT
     HANDLE hProcess= OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid);
+#else
+    HANDLE hProcess = (HANDLE) pid;
+#endif
 
     if (hProcess == NULL) {
        croak("kill process failed!\n");
@@ -852,6 +858,10 @@ kill(int pid, int sig)
        if (!TerminateProcess(hProcess, sig))
            croak("kill process failed!\n");
        CloseHandle(hProcess);
+
+       /* WaitForMultipleObjects() on a pid that was killed returns error
+        * so if we know the pid is gone we remove it from process list */
+       remove_dead_process(hProcess);
     }
     return 0;
 }
@@ -870,7 +880,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;
@@ -887,8 +897,22 @@ 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;
+       }
+    }
 #ifdef __BORLANDC__
-    if (res == 0) {
+    else {
        if (S_ISDIR(buffer->st_mode))
            buffer->st_mode |= S_IWRITE | S_IEXEC;
        else if (S_ISREG(buffer->st_mode)) {
@@ -915,11 +939,13 @@ 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);
+    }
 
     needlen = GetEnvironmentVariable(name,curitem,curlen);
     if (needlen != 0) {
@@ -929,23 +955,22 @@ win32_getenv(const char *name)
            needlen = GetEnvironmentVariable(name,curitem,curlen);
        }
     }
-    else
-    {
-       /* allow any environment variables that begin with 'PERL5'
-          to be stored in the registry
-       */
-       if(curitem != NULL)
+    else {
+       /* allow any environment variables that begin with 'PERL'
+          to be stored in the registry */
+       if (curitem)
            *curitem = '\0';
 
-       if (strncmp(name, "PERL5", 5) == 0) {
-           if (curitem != NULL) {
+       if (strncmp(name, "PERL", 4) == 0) {
+           if (curitem) {
                Safefree(curitem);
-               curitem = NULL;
+               curitem = Nullch;
+               curlen = 0;
            }
            curitem = GetRegStr(name, &curitem, &curlen);
        }
     }
-    if(curitem != NULL && *curitem == '\0')
+    if (curitem && *curitem == '\0')
        return Nullch;
 
     return curitem;
@@ -1050,6 +1075,24 @@ win32_utime(const char *filename, struct utimbuf *times)
 }
 
 DllExport int
+win32_waitpid(int pid, int *status, int flags)
+{
+    int rc;
+    if (pid == -1) 
+      return win32_wait(status);
+    else {
+      rc = cwait(status, pid, WAIT_CHILD);
+    /* cwait() returns differently on Borland */
+#ifdef __BORLANDC__
+    if (status)
+       *status =  (((*status >> 8) & 0xff) | ((*status << 8) & 0xff00));
+#endif
+      remove_dead_process((HANDLE)pid);
+    }
+    return rc >= 0 ? pid : rc;                
+}
+
+DllExport int
 win32_wait(int *status)
 {
 #ifdef USE_RTL_WAIT
@@ -1133,14 +1176,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
 
@@ -1666,10 +1716,6 @@ win32_pclose(FILE *pf)
     return _pclose(pf);
 #else
 
-#ifndef USE_RTL_WAIT
-    int child;
-#endif
-
     int childpid, status;
     SV *sv;
 
@@ -1687,16 +1733,7 @@ win32_pclose(FILE *pf)
     win32_fclose(pf);
     SvIVX(sv) = 0;
 
-#ifndef USE_RTL_WAIT
-    for (child = 0 ; child < w32_num_children ; ++child) {
-       if (w32_child_pids[child] == (HANDLE)childpid) {
-           Copy(&w32_child_pids[child+1], &w32_child_pids[child],
-                (w32_num_children-child-1), HANDLE);
-           w32_num_children--;
-           break;
-       }
-    }
-#endif
+    remove_dead_process((HANDLE)childpid);
 
     /* wait for the child */
     if (cwait(&status, childpid, WAIT_CHILD) == -1)
@@ -1712,6 +1749,56 @@ win32_pclose(FILE *pf)
 }
 
 DllExport int
+win32_rename(const char *oname, const char *newname)
+{
+    char szNewWorkName[MAX_PATH+1];
+    WIN32_FIND_DATA fdOldFile, fdNewFile;
+    HANDLE handle;
+    char *ptr;
+
+    if ((strchr(oname, '\\') || strchr(oname, '/'))
+       && strchr(newname, '\\') == NULL
+       && strchr(newname, '/') == NULL)
+    {
+       strcpy(szNewWorkName, oname);
+       if ((ptr = strrchr(szNewWorkName, '\\')) == NULL)
+           ptr = strrchr(szNewWorkName, '/');
+       strcpy(++ptr, newname);
+    }
+    else
+       strcpy(szNewWorkName, newname);
+
+    if (stricmp(oname, szNewWorkName) != 0) {
+       // check that we're not being fooled by relative paths
+       // and only delete the new file
+       //  1) if it exists
+       //  2) it is not the same file as the old file
+       //  3) old file exist
+       // GetFullPathName does not return the long file name on some systems
+       handle = FindFirstFile(oname, &fdOldFile);
+       if (handle != INVALID_HANDLE_VALUE) {
+           FindClose(handle);
+    
+           handle = FindFirstFile(szNewWorkName, &fdNewFile);
+    
+           if (handle != INVALID_HANDLE_VALUE)
+               FindClose(handle);
+           else
+               fdNewFile.cFileName[0] = '\0';
+
+           if (strcmp(fdOldFile.cAlternateFileName,
+                      fdNewFile.cAlternateFileName) != 0
+               && strcmp(fdOldFile.cFileName, fdNewFile.cFileName) != 0)
+           {
+               // file exists and not same file
+               DeleteFile(szNewWorkName);
+           }
+       }
+    }
+    return rename(oname, newname);
+}
+
+DllExport int
 win32_setmode(int fd, int mode)
 {
     return setmode(fd, mode);
@@ -1821,6 +1908,12 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
 }
 
 DllExport int
+win32_execv(const char *cmdname, const char *const *argv)
+{
+    return execv(cmdname, (char *const *)argv);
+}
+
+DllExport int
 win32_execvp(const char *cmdname, const char *const *argv)
 {
     return execvp(cmdname, (char *const *)argv);
@@ -2046,7 +2139,7 @@ XS(w32_SetCwd)
     dXSARGS;
     if (items != 1)
        croak("usage: Win32::SetCurrentDirectory($cwd)");
-    if (SetCurrentDirectory(SvPV(ST(0),na)))
+    if (SetCurrentDirectory(SvPV(ST(0),PL_na)))
        XSRETURN_YES;
 
     XSRETURN_NO;
@@ -2118,7 +2211,7 @@ XS(w32_DomainName)
        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 */
        }
@@ -2229,8 +2322,8 @@ XS(w32_Spawn)
     if (items != 3)
        croak("usage: Win32::Spawn($cmdName, $args, $PID)");
 
-    cmd = SvPV(ST(0),na);
-    args = SvPV(ST(1), na);
+    cmd = SvPV(ST(0),PL_na);
+    args = SvPV(ST(1), PL_na);
 
     memset(&stStartInfo, 0, sizeof(stStartInfo));   /* Clear the block */
     stStartInfo.cb = sizeof(stStartInfo);          /* Set the structure size */
@@ -2286,7 +2379,7 @@ XS(w32_GetShortPathName)
        ST(0) = shortpath;
     }
     else
-       ST(0) = &sv_undef;
+       ST(0) = &PL_sv_undef;
     XSRETURN(1);
 }