s/TMP_CRLF_PATCH/PERL_STRICT_CR/ with sense reversed, so they
[p5sagit/p5-mst-13.2.git] / win32 / win32.c
index 3a0583c..721b62a 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
@@ -111,6 +95,7 @@ static BOOL          has_redirection(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;
@@ -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 {
@@ -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;
@@ -483,7 +470,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 +478,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 +491,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);
@@ -597,7 +584,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 +592,7 @@ do_spawn2(char *cmd, int exectype)
        }
        else
            status *= 256;
-       statusvalue = status;
+       PL_statusvalue = status;
     }
     return (status);
 }
@@ -634,7 +621,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;
@@ -712,7 +699,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 +727,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 +737,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 +827,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 +859,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 +881,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;
@@ -931,13 +942,13 @@ win32_getenv(const char *name)
     }
     else
     {
-       /* allow any environment variables that begin with 'PERL5'
+       /* allow any environment variables that begin with 'PERL'
           to be stored in the registry
        */
        if(curitem != NULL)
            *curitem = '\0';
 
-       if (strncmp(name, "PERL5", 5) == 0) {
+       if (strncmp(name, "PERL", 4) == 0) {
            if (curitem != NULL) {
                Safefree(curitem);
                curitem = NULL;
@@ -1050,6 +1061,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 +1162,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);
+#endif
 
 DllExport char *
 win32_crypt(const char *txt, const char *salt)
 {
+#ifdef HAVE_DES_FCRYPT
     dTHR;
     return des_fcrypt(crypt_buffer, txt, salt);
+#else
+    die("The crypt() function is unimplemented due to excessive paranoia.");
+    return Nullch;
+#endif
 }
 #endif
 
@@ -1666,10 +1702,6 @@ win32_pclose(FILE *pf)
     return _pclose(pf);
 #else
 
-#ifndef USE_RTL_WAIT
-    int child;
-#endif
-
     int childpid, status;
     SV *sv;
 
@@ -1687,16 +1719,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 +1735,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);
@@ -2052,7 +2125,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;
@@ -2124,7 +2197,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 */
        }
@@ -2235,8 +2308,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 */
@@ -2292,7 +2365,7 @@ XS(w32_GetShortPathName)
        ST(0) = shortpath;
     }
     else
-       ST(0) = &sv_undef;
+       ST(0) = &PL_sv_undef;
     XSRETURN(1);
 }