X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2Fwin32.c;h=924ee92a7ea90aede7b87899c5648b94680add22;hb=16b7a9a47be196cb33bf757faad24e73ceffc2fc;hp=7cc8a271b82ba2e34fbc01b5c9e38124baf4b0c9;hpb=b8b4c9f3cf6ef09c878a80ff97526a69902a44ca;p=p5sagit%2Fp5-mst-13.2.git diff --git a/win32/win32.c b/win32/win32.c index 7cc8a27..924ee92 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -15,6 +15,11 @@ #define Win32_Winsock #endif #include +#ifndef __MINGW32__ /* GCC/Mingw32-2.95.2 forgot the WINAPI on CommandLineToArgvW() */ +# include +#else + LPWSTR* WINAPI CommandLineToArgvW(LPCWSTR lpCommandLine, int * pNumArgs); +#endif #include #include @@ -41,7 +46,6 @@ #endif #include #include -#include /* get a real declaration of sys_nerr */ #include #include #if defined(_MSC_VER) || defined(__MINGW32__) @@ -49,7 +53,6 @@ #else #include #endif - #ifdef __GNUC__ /* Mingw32 defaults to globing command line * So we turn it off like this: @@ -433,12 +436,19 @@ win32_os_id(void) DllExport int win32_getpid(void) { + int pid; #ifdef USE_ITHREADS dTHXo; if (w32_pseudo_id) return -((int)w32_pseudo_id); #endif - return _getpid(); + pid = _getpid(); + /* Windows 9x appears to always reports a pid for threads and processes + * that has the high bit set. So we treat the lower 31 bits as the + * "real" PID for Perl's purposes. */ + if (IsWin95() && pid < 0) + pid = -pid; + return pid; } /* Tokenize a string. Words are null-separated, and the list @@ -565,9 +575,12 @@ do_aspawn(void *vreally, void **vmark, void **vsp) (const char* const*)argv); } - if (flag != P_NOWAIT) { + if (flag == P_NOWAIT) { + if (IsWin95()) + PL_statusvalue = -1; /* >16bits hint for pp_system() */ + } + else { if (status < 0) { - dTHR; if (ckWARN(WARN_EXEC)) Perl_warner(aTHX_ WARN_EXEC, "Can't spawn \"%s\": %s", argv[0], strerror(errno)); status = 255 * 256; @@ -654,9 +667,12 @@ do_spawn2(char *cmd, int exectype) cmd = argv[0]; Safefree(argv); } - if (exectype != EXECF_SPAWN_NOWAIT) { + if (exectype == EXECF_SPAWN_NOWAIT) { + if (IsWin95()) + PL_statusvalue = -1; /* >16bits hint for pp_system() */ + } + else { if (status < 0) { - dTHR; if (ckWARN(WARN_EXEC)) Perl_warner(aTHX_ WARN_EXEC, "Can't %s \"%s\": %s", (exectype == EXECF_EXEC ? "exec" : "spawn"), @@ -959,6 +975,31 @@ chown(const char *path, uid_t owner, gid_t group) return 0; } +/* + * XXX this needs strengthening (for PerlIO) + * -- BKS, 11-11-200 +*/ +int mkstemp(const char *path) +{ + dTHX; + char buf[MAX_PATH+1]; + int i = 0, fd = -1; + +retry: + if (i++ > 10) { /* give up */ + errno = ENOENT; + return -1; + } + if (!GetTempFileNameA((LPCSTR)path, "plr", 1, buf)) { + errno = ENOENT; + return -1; + } + fd = PerlLIO_open3(buf, O_CREAT|O_RDWR|O_EXCL, 0600); + if (fd == -1) + goto retry; + return fd; +} + static long find_pid(int pid) { @@ -1018,10 +1059,11 @@ win32_kill(int pid, int sig) { dTHXo; HANDLE hProcess; + long child; #ifdef USE_ITHREADS if (pid < 0) { /* it is a pseudo-forked child */ - long child = find_pseudo_pid(-pid); + child = find_pseudo_pid(-pid); if (child >= 0) { if (!sig) return 0; @@ -1031,11 +1073,15 @@ win32_kill(int pid, int sig) return 0; } } + else if (IsWin95()) { + pid = -pid; + goto alien_process; + } } else #endif { - long child = find_pid(pid); + child = find_pid(pid); if (child >= 0) { if (!sig) return 0; @@ -1046,7 +1092,9 @@ win32_kill(int pid, int sig) } } else { - hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid); +alien_process: + hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, + (IsWin95() ? -pid : pid)); if (hProcess) { if (!sig) return 0; @@ -1608,12 +1656,8 @@ win32_uname(struct utsname *name) char *arch; GetSystemInfo(&info); -#if defined(__BORLANDC__) || defined(__MINGW32__) -#ifndef _STRUCT_NAME -# define _STRUCT_NAME(s) s -# define _UNION_NAME(u) u -#endif - switch (info._UNION_NAME(u.)_STRUCT_NAME(s.)wProcessorArchitecture) { +#if (defined(__BORLANDC__)&&(__BORLANDC__<=0x520)) || defined(__MINGW32__) + switch (info.u.s.wProcessorArchitecture) { #else switch (info.wProcessorArchitecture) { #endif @@ -1637,34 +1681,48 @@ DllExport int win32_waitpid(int pid, int *status, int flags) { dTHXo; + DWORD timeout = (flags & WNOHANG) ? 0 : INFINITE; int retval = -1; + long child; if (pid == -1) /* XXX threadid == 1 ? */ return win32_wait(status); #ifdef USE_ITHREADS else if (pid < 0) { - long child = find_pseudo_pid(-pid); + child = find_pseudo_pid(-pid); if (child >= 0) { HANDLE hThread = w32_pseudo_child_handles[child]; - DWORD waitcode = WaitForSingleObject(hThread, INFINITE); - if (waitcode != WAIT_FAILED) { + DWORD waitcode = WaitForSingleObject(hThread, timeout); + if (waitcode == WAIT_TIMEOUT) { + return 0; + } + else if (waitcode != WAIT_FAILED) { if (GetExitCodeThread(hThread, &waitcode)) { *status = (int)((waitcode & 0xff) << 8); retval = (int)w32_pseudo_child_pids[child]; remove_dead_pseudo_process(child); - return retval; + return -retval; } } else errno = ECHILD; } + else if (IsWin95()) { + pid = -pid; + goto alien_process; + } } #endif else { - long child = find_pid(pid); + HANDLE hProcess; + DWORD waitcode; + child = find_pid(pid); if (child >= 0) { - HANDLE hProcess = w32_child_handles[child]; - DWORD waitcode = WaitForSingleObject(hProcess, INFINITE); - if (waitcode != WAIT_FAILED) { + hProcess = w32_child_handles[child]; + waitcode = WaitForSingleObject(hProcess, timeout); + if (waitcode == WAIT_TIMEOUT) { + return 0; + } + else if (waitcode != WAIT_FAILED) { if (GetExitCodeProcess(hProcess, &waitcode)) { *status = (int)((waitcode & 0xff) << 8); retval = (int)w32_child_pids[child]; @@ -1676,12 +1734,25 @@ win32_waitpid(int pid, int *status, int flags) errno = ECHILD; } else { - retval = cwait(status, pid, WAIT_CHILD); - /* cwait() returns "correctly" on Borland */ -#ifndef __BORLANDC__ - if (status) - *status *= 256; -#endif +alien_process: + hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, + (IsWin95() ? -pid : pid)); + if (hProcess) { + waitcode = WaitForSingleObject(hProcess, timeout); + if (waitcode == WAIT_TIMEOUT) { + return 0; + } + else if (waitcode != WAIT_FAILED) { + if (GetExitCodeProcess(hProcess, &waitcode)) { + *status = (int)((waitcode & 0xff) << 8); + CloseHandle(hProcess); + return pid; + } + } + CloseHandle(hProcess); + } + else + errno = ECHILD; } } return retval >= 0 ? pid : retval; @@ -1713,7 +1784,7 @@ win32_wait(int *status) *status = (int)((exitcode & 0xff) << 8); retval = (int)w32_pseudo_child_pids[i]; remove_dead_pseudo_process(i); - return retval; + return -retval; } } } @@ -1802,7 +1873,6 @@ win32_crypt(const char *txt, const char *salt) { dTHXo; #ifdef HAVE_DES_FCRYPT - dTHR; return des_fcrypt(txt, salt, w32_crypt_buffer); #else Perl_croak(aTHX_ "The crypt() function is unimplemented due to excessive paranoia."); @@ -1810,53 +1880,6 @@ win32_crypt(const char *txt, const char *salt) #endif } -/* C doesn't like repeat struct definitions */ - -#if defined(USE_FIXED_OSFHANDLE) || defined(PERL_MSVCRT_READFIX) - -#ifndef _CRTIMP -#define _CRTIMP __declspec(dllimport) -#endif - -/* - * Control structure for lowio file handles - */ -typedef struct { - long osfhnd; /* underlying OS file HANDLE */ - char osfile; /* attributes of file (e.g., open in text mode?) */ - char pipech; /* one char buffer for handles opened on pipes */ - int lockinitflag; - CRITICAL_SECTION lock; -} ioinfo; - - -/* - * Array of arrays of control structures for lowio files. - */ -EXTERN_C _CRTIMP ioinfo* __pioinfo[]; - -/* - * Definition of IOINFO_L2E, the log base 2 of the number of elements in each - * array of ioinfo structs. - */ -#define IOINFO_L2E 5 - -/* - * Definition of IOINFO_ARRAY_ELTS, the number of elements in ioinfo array - */ -#define IOINFO_ARRAY_ELTS (1 << IOINFO_L2E) - -/* - * Access macros for getting at an ioinfo struct and its fields from a - * file handle - */ -#define _pioinfo(i) (__pioinfo[(i) >> IOINFO_L2E] + ((i) & (IOINFO_ARRAY_ELTS - 1))) -#define _osfhnd(i) (_pioinfo(i)->osfhnd) -#define _osfile(i) (_pioinfo(i)->osfile) -#define _pipech(i) (_pioinfo(i)->pipech) - -#endif - #ifdef USE_FIXED_OSFHANDLE #define FOPEN 0x01 /* file handle open */ @@ -1895,10 +1918,6 @@ EXTERN_C _CRTIMP ioinfo* __pioinfo[]; * -- BKS, 1-23-2000 */ -/* since we are not doing a dup2(), this works fine */ - -#define _set_osfhnd(fh, osfh) (void)(_osfhnd(fh) = osfh) - /* create an ioinfo entry, kill its handle, and steal the entry */ static int @@ -2057,6 +2076,9 @@ win32_feof(FILE *fp) DllExport char * win32_strerror(int e) { +#ifndef __BORLANDC__ /* Borland intolerance */ + extern int sys_nerr; +#endif DWORD source = 0; if (e < 0 || e > sys_nerr) { @@ -2106,7 +2128,6 @@ win32_str_os_error(void *sv, DWORD dwErr) } } - DllExport int win32_fprintf(FILE *fp, const char *format, ...) { @@ -2312,7 +2333,25 @@ win32_abort(void) DllExport int win32_fstat(int fd,struct stat *sbufptr) { - return fstat(fd,sbufptr); +#ifdef __BORLANDC__ + /* A file designated by filehandle is not shown as accessible + * for write operations, probably because it is opened for reading. + * --Vadim Konovalov + */ + int rc = fstat(fd,sbufptr); + BY_HANDLE_FILE_INFORMATION bhfi; + if (GetFileInformationByHandle((HANDLE)_get_osfhandle(fd), &bhfi)) { + sbufptr->st_mode &= 0xFE00; + if (bhfi.dwFileAttributes & FILE_ATTRIBUTE_READONLY) + sbufptr->st_mode |= (S_IREAD + (S_IREAD >> 3) + (S_IREAD >> 6)); + else + sbufptr->st_mode |= ((S_IREAD|S_IWRITE) + ((S_IREAD|S_IWRITE) >> 3) + + ((S_IREAD|S_IWRITE) >> 6)); + } + return rc; +#else + return my_fstat(fd,sbufptr); +#endif } DllExport int @@ -2323,9 +2362,11 @@ win32_pipe(int *pfd, unsigned int size, int mode) /* * a popen() clone that respects PERL5SHELL + * + * changed to return PerlIO* rather than FILE * by BKS, 11-11-2000 */ -DllExport FILE* +DllExport PerlIO* win32_popen(const char *command, const char *mode) { #ifdef USE_RTL_POPEN @@ -2390,16 +2431,16 @@ win32_popen(const char *command, const char *mode) /* close saved handle */ win32_close(oldfd); - FDPID_LOCK; + LOCK_FDPID_MUTEX; sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid); - FDPID_UNLOCK; + UNLOCK_FDPID_MUTEX; /* set process id so that it can be returned by perl's open() */ PL_forkprocess = childpid; } /* we have an fd, return a file stream */ - return (win32_fdopen(p[parent], (char *)mode)); + return (PerlIO_fdopen(p[parent], (char *)mode)); cleanup: /* we don't need to check for errors here */ @@ -2419,7 +2460,7 @@ cleanup: */ DllExport int -win32_pclose(FILE *pf) +win32_pclose(PerlIO *pf) { #ifdef USE_RTL_POPEN return _pclose(pf); @@ -2428,9 +2469,9 @@ win32_pclose(FILE *pf) int childpid, status; SV *sv; - FDPID_LOCK; - sv = *av_fetch(w32_fdpid, win32_fileno(pf), TRUE); - FDPID_UNLOCK; + LOCK_FDPID_MUTEX; + sv = *av_fetch(w32_fdpid, PerlIO_fileno(pf), TRUE); + if (SvIOK(sv)) childpid = SvIVX(sv); else @@ -2441,8 +2482,13 @@ win32_pclose(FILE *pf) return -1; } - win32_fclose(pf); +#ifdef USE_PERLIO + PerlIO_close(pf); +#else + fclose(pf); +#endif SvIVX(sv) = 0; + UNLOCK_FDPID_MUTEX; if (win32_waitpid(childpid, &status, 0) == -1) return -1; @@ -2490,8 +2536,8 @@ Nt4CreateHardLinkW( StreamId.dwStreamAttributes = 0; StreamId.dwStreamNameSize = 0; #if defined(__BORLANDC__) || defined(__MINGW32__) - StreamId.Size._UNION_NAME(u.)HighPart = 0; - StreamId.Size._UNION_NAME(u.)LowPart = dwLen; + StreamId.Size.u.HighPart = 0; + StreamId.Size.u.LowPart = dwLen; #else StreamId.Size.HighPart = 0; StreamId.Size.LowPart = dwLen; @@ -2702,10 +2748,13 @@ win32_open(const char *path, int flag, ...) return open(PerlDir_mapA(path), flag, pmode); } +/* close() that understands socket */ +extern int my_close(int); /* in win32sck.c */ + DllExport int win32_close(int fd) { - return close(fd); + return my_close(fd); } DllExport int @@ -3262,9 +3311,12 @@ RETRY: if (mode == P_NOWAIT) { /* asynchronous spawn -- store handle, return PID */ - w32_child_handles[w32_num_children] = ProcessInformation.hProcess; - w32_child_pids[w32_num_children] = ProcessInformation.dwProcessId; ret = (int)ProcessInformation.dwProcessId; + if (IsWin95() && ret < 0) + ret = -ret; + + w32_child_handles[w32_num_children] = ProcessInformation.hProcess; + w32_child_pids[w32_num_children] = (DWORD)ret; ++w32_num_children; } else { @@ -3509,6 +3561,25 @@ win32_dynaload(const char* filename) { dTHXo; HMODULE hModule; + char buf[MAX_PATH+1]; + char *first; + + /* LoadLibrary() doesn't recognize forward slashes correctly, + * so turn 'em back. */ + first = strchr(filename, '/'); + if (first) { + STRLEN len = strlen(filename); + if (len <= MAX_PATH) { + strcpy(buf, filename); + filename = &buf[first - filename]; + while (*filename) { + if (*filename == '/') + *(char*)filename = '\\'; + ++filename; + } + filename = buf; + } + } if (USING_WIDE()) { WCHAR wfilename[MAX_PATH+1]; A2WHELPER(filename, wfilename, sizeof(wfilename)); @@ -3824,8 +3895,11 @@ XS(w32_Spawn) &stStartInfo, /* -> Startup info */ &stProcInfo)) /* <- Process info (if OK) */ { + int pid = (int)stProcInfo.dwProcessId; + if (IsWin95() && pid < 0) + pid = -pid; + sv_setiv(ST(2), pid); CloseHandle(stProcInfo.hThread);/* library source code does this. */ - sv_setiv(ST(2), stProcInfo.dwProcessId); bSuccess = TRUE; } XSRETURN_IV(bSuccess); @@ -3854,6 +3928,9 @@ XS(w32_GetShortPathName) shortpath = sv_mortalcopy(ST(0)); SvUPGRADE(shortpath, SVt_PV); + if (!SvPVX(shortpath) || !SvLEN(shortpath)) + XSRETURN_UNDEF; + /* src == target is allowed */ do { len = GetShortPathName(SvPVX(shortpath), @@ -3883,6 +3960,9 @@ XS(w32_GetFullPathName) filename = ST(0); fullpath = sv_mortalcopy(filename); SvUPGRADE(fullpath, SVt_PV); + if (!SvPVX(fullpath) || !SvLEN(fullpath)) + XSRETURN_UNDEF; + do { len = GetFullPathName(SvPVX(filename), SvLEN(fullpath), @@ -4033,6 +4113,8 @@ win32_get_child_IO(child_IO_table* ptbl) # define Perl_sys_intern_init CPerlObj::Perl_sys_intern_init # undef Perl_sys_intern_dup # define Perl_sys_intern_dup CPerlObj::Perl_sys_intern_dup +# undef Perl_sys_intern_clear +# define Perl_sys_intern_clear CPerlObj::Perl_sys_intern_clear # define pPerl this # endif @@ -4053,6 +4135,18 @@ Perl_sys_intern_init(pTHX) w32_init_socktype = 0; } +void +Perl_sys_intern_clear(pTHX) +{ + Safefree(w32_perlshell_tokens); + Safefree(w32_perlshell_vec); + /* NOTE: w32_fdpid is freed by sv_clean_all() */ + Safefree(w32_children); +# ifdef USE_ITHREADS + Safefree(w32_pseudo_children); +# endif +} + # ifdef USE_ITHREADS void @@ -4065,7 +4159,7 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst) Newz(1313, dst->children, 1, child_tab); dst->pseudo_id = 0; Newz(1313, dst->pseudo_children, 1, child_tab); - dst->thr_intern.Winit_socktype = src->thr_intern.Winit_socktype; + dst->thr_intern.Winit_socktype = 0; } # endif /* USE_ITHREADS */ #endif /* HAVE_INTERP_INTERN */ @@ -4085,21 +4179,13 @@ win32_free_argvw(pTHXo_ void *ptr) } } -typedef LPWSTR* (WINAPI CLTARGVW)(LPCWSTR lpCommandLine, int * pNumArgs); -/* load shell32.dll on demand (reduces number of DLLs loaded on startup by 1/3) - -- BKS 5-28-2000 */ void win32_argv2utf8(int argc, char** argv) { dTHXo; char* psz; int length, wargc; - HANDLE hDll = LoadLibraryA("shell32.dll"); - CLTARGVW *pCommandLineToArgvW = NULL; - LPWSTR* lpwStr = NULL; - if (hDll && (pCommandLineToArgvW = (CLTARGVW*)GetProcAddress(hDll, "CommandLineToArgvW"))) { - lpwStr = (*pCommandLineToArgvW)(GetCommandLineW(), &wargc); - } + LPWSTR* lpwStr = CommandLineToArgvW(GetCommandLineW(), &wargc); if (lpwStr && argc) { while (argc--) { length = WideCharToMultiByte(CP_UTF8, 0, lpwStr[--wargc], -1, NULL, 0, NULL, NULL); @@ -4109,7 +4195,6 @@ win32_argv2utf8(int argc, char** argv) } call_atexit(win32_free_argvw, argv); } - if (hDll) - FreeLibrary(hDll); GlobalFree((HGLOBAL)lpwStr); } +