X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2Fwin32.c;h=924ee92a7ea90aede7b87899c5648b94680add22;hb=16b7a9a47be196cb33bf757faad24e73ceffc2fc;hp=49a8deee523f0e6859c45d852a4ca8f3c216b388;hpb=9e5f57defb0d4fe4a23e6e24c3d57478465aea87;p=p5sagit%2Fp5-mst-13.2.git diff --git a/win32/win32.c b/win32/win32.c index 49a8dee..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 @@ -48,7 +53,6 @@ #else #include #endif - #ifdef __GNUC__ /* Mingw32 defaults to globing command line * So we turn it off like this: @@ -57,7 +61,12 @@ int _CRT_glob = 0; #endif #if defined(__MINGW32__) -# define _stat stat +/* Mingw32 is missing some prototypes */ +FILE * _wfopen(LPCWSTR wszFileName, LPCWSTR wszMode); +FILE * _wfdopen(int nFd, LPCWSTR wszMode); +FILE * _freopen(LPCWSTR wszFileName, LPCWSTR wszMode, FILE * pOldStream); +int _flushall(); +int _fcloseall(); #endif #if defined(__BORLANDC__) @@ -74,6 +83,8 @@ int _CRT_glob = 0; # define win32_get_privlib g_win32_get_privlib # undef win32_get_sitelib # define win32_get_sitelib g_win32_get_sitelib +# undef win32_get_vendorlib +# define win32_get_vendorlib g_win32_get_vendorlib # undef do_spawn # define do_spawn g_do_spawn # undef getlogin @@ -97,6 +108,9 @@ static char * get_emd_part(SV **leading, char *trailing, ...); static void remove_dead_process(long deceased); static long find_pid(int pid); static char * qualified_path(const char *cmd); +static char * win32_get_xlib(const char *pl, const char *xlib, + const char *libname); + #ifdef USE_ITHREADS static void remove_dead_pseudo_process(long child); static long find_pseudo_pid(int pid); @@ -123,6 +137,30 @@ IsWinNT(void) return (win32_os_id() == VER_PLATFORM_WIN32_NT); } +EXTERN_C void +set_w32_module_name(void) +{ + char* ptr; + GetModuleFileName((HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE) + ? GetModuleHandle(NULL) + : w32_perldll_handle), + w32_module_name, sizeof(w32_module_name)); + + /* try to get full path to binary (which may be mangled when perl is + * run from a 16-bit app) */ + /*PerlIO_printf(Perl_debug_log, "Before %s\n", w32_module_name);*/ + (void)win32_longpath(w32_module_name); + /*PerlIO_printf(Perl_debug_log, "After %s\n", w32_module_name);*/ + + /* normalize to forward slashes */ + ptr = w32_module_name; + while (*ptr) { + if (*ptr == '\\') + *ptr = '/'; + ++ptr; + } +} + /* *svp (if non-NULL) is expected to be POK (valid allocated SvPVX(*svp)) */ static char* get_regstr_from(HKEY hkey, const char *valuename, SV **svp) @@ -138,7 +176,9 @@ get_regstr_from(HKEY hkey, const char *valuename, SV **svp) if (retval == ERROR_SUCCESS) { DWORD datalen; retval = RegQueryValueEx(handle, valuename, 0, &type, NULL, &datalen); - if (retval == ERROR_SUCCESS && type == REG_SZ) { + if (retval == ERROR_SUCCESS + && (type == REG_SZ || type == REG_EXPAND_SZ)) + { dTHXo; if (!*svp) *svp = sv_2mortal(newSVpvn("",0)); @@ -185,24 +225,7 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...) baselen = strlen(base); if (!*w32_module_name) { - GetModuleFileName((HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE) - ? GetModuleHandle(NULL) - : w32_perldll_handle), - w32_module_name, sizeof(w32_module_name)); - - /* try to get full path to binary (which may be mangled when perl is - * run from a 16-bit app) */ - /*PerlIO_printf(Perl_debug_log, "Before %s\n", w32_module_name);*/ - (void)win32_longpath(w32_module_name); - /*PerlIO_printf(Perl_debug_log, "After %s\n", w32_module_name);*/ - - /* normalize to forward slashes */ - ptr = w32_module_name; - while (*ptr) { - if (*ptr == '\\') - *ptr = '/'; - ++ptr; - } + set_w32_module_name(); } strcpy(mod_name, w32_module_name); ptr = strrchr(mod_name, '/'); @@ -248,7 +271,7 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...) } char * -win32_get_privlib(char *pl) +win32_get_privlib(const char *pl) { dTHXo; char *stdlib = "lib"; @@ -264,11 +287,10 @@ win32_get_privlib(char *pl) return get_emd_part(&sv, stdlib, ARCHNAME, "bin", Nullch); } -char * -win32_get_sitelib(char *pl) +static char * +win32_get_xlib(const char *pl, const char *xlib, const char *libname) { dTHXo; - char *sitelib = "sitelib"; char regstr[40]; char pathstr[MAX_PATH+1]; DWORD datalen; @@ -276,21 +298,22 @@ win32_get_sitelib(char *pl) SV *sv1 = Nullsv; SV *sv2 = Nullsv; - /* $HKCU{"sitelib-$]"} || $HKLM{"sitelib-$]"} . ---; */ - sprintf(regstr, "%s-%s", sitelib, pl); + /* $HKCU{"$xlib-$]"} || $HKLM{"$xlib-$]"} . ---; */ + sprintf(regstr, "%s-%s", xlib, pl); (void)get_regstr(regstr, &sv1); - /* $sitelib .= - * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/$]/lib"; */ - sprintf(pathstr, "site/%s/lib", pl); + /* $xlib .= + * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/$]/lib"; */ + sprintf(pathstr, "%s/%s/lib", libname, pl); (void)get_emd_part(&sv1, pathstr, ARCHNAME, "bin", pl, Nullch); - /* $HKCU{'sitelib'} || $HKLM{'sitelib'} . ---; */ - (void)get_regstr(sitelib, &sv2); + /* $HKCU{$xlib} || $HKLM{$xlib} . ---; */ + (void)get_regstr(xlib, &sv2); - /* $sitelib .= - * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/lib"; */ - (void)get_emd_part(&sv2, "site/lib", ARCHNAME, "bin", pl, Nullch); + /* $xlib .= + * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/lib"; */ + sprintf(pathstr, "%s/lib", libname); + (void)get_emd_part(&sv2, pathstr, ARCHNAME, "bin", pl, Nullch); if (!sv1 && !sv2) return Nullch; @@ -305,6 +328,21 @@ win32_get_sitelib(char *pl) return SvPVX(sv1); } +char * +win32_get_sitelib(const char *pl) +{ + return win32_get_xlib(pl, "sitelib", "site"); +} + +#ifndef PERL_VENDORLIB_NAME +# define PERL_VENDORLIB_NAME "vendor" +#endif + +char * +win32_get_vendorlib(const char *pl) +{ + return win32_get_xlib(pl, "vendorlib", PERL_VENDORLIB_NAME); +} static BOOL has_shell_metachars(char *ptr) @@ -398,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 @@ -530,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; @@ -619,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"), @@ -924,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) { @@ -983,23 +1059,32 @@ 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; hProcess = w32_pseudo_child_handles[child]; if (TerminateThread(hProcess, sig)) { remove_dead_pseudo_process(child); 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; hProcess = w32_child_handles[child]; if (TerminateProcess(hProcess, sig)) { remove_dead_process(child); @@ -1007,10 +1092,16 @@ win32_kill(int pid, int sig) } } else { - hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid); - if (hProcess && TerminateProcess(hProcess, sig)) { - CloseHandle(hProcess); - return 0; +alien_process: + hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, + (IsWin95() ? -pid : pid)); + if (hProcess) { + if (!sig) + return 0; + if (TerminateProcess(hProcess, sig)) { + CloseHandle(hProcess); + return 0; + } } } } @@ -1030,13 +1121,14 @@ win32_sleep(unsigned int t) } DllExport int -win32_stat(const char *path, struct stat *buffer) +win32_stat(const char *path, struct stat *sbuf) { dTHXo; - char t[MAX_PATH+1]; + char buffer[MAX_PATH+1]; int l = strlen(path); int res; WCHAR wbuffer[MAX_PATH+1]; + WCHAR* pwbuffer; HANDLE handle; int nlink = 1; @@ -1045,17 +1137,20 @@ win32_stat(const char *path, struct stat *buffer) /* FindFirstFile() and stat() are buggy with a trailing * backslash, so change it to a forward slash :-( */ case '\\': - strncpy(t, path, l-1); - t[l - 1] = '/'; - t[l] = '\0'; - path = t; + strncpy(buffer, path, l-1); + buffer[l - 1] = '/'; + buffer[l] = '\0'; + path = buffer; break; /* FindFirstFile() is buggy with "x:", so add a dot :-( */ case ':': if (l == 2 && isALPHA(path[0])) { - t[0] = path[0]; t[1] = ':'; t[2] = '.'; t[3] = '\0'; + buffer[0] = path[0]; + buffer[1] = ':'; + buffer[2] = '.'; + buffer[3] = '\0'; l = 3; - path = t; + path = buffer; } break; } @@ -1066,11 +1161,12 @@ win32_stat(const char *path, struct stat *buffer) /* This also gives us an opportunity to determine the number of links. */ if (USING_WIDE()) { A2WHELPER(path, wbuffer, sizeof(wbuffer)); - wcscpy(wbuffer, PerlDir_mapW(wbuffer)); - handle = CreateFileW(wbuffer, 0, 0, NULL, OPEN_EXISTING, 0, NULL); + pwbuffer = PerlDir_mapW(wbuffer); + handle = CreateFileW(pwbuffer, 0, 0, NULL, OPEN_EXISTING, 0, NULL); } else { path = PerlDir_mapA(path); + l = strlen(path); handle = CreateFileA(path, 0, 0, NULL, OPEN_EXISTING, 0, NULL); } if (handle != INVALID_HANDLE_VALUE) { @@ -1080,34 +1176,34 @@ win32_stat(const char *path, struct stat *buffer) CloseHandle(handle); } - /* wbuffer or path will be mapped correctly above */ + /* pwbuffer or path will be mapped correctly above */ if (USING_WIDE()) { - res = _wstat(wbuffer, (struct _stat *)buffer); + res = _wstat(pwbuffer, (struct _stat *)sbuf); } else { - res = stat(path, buffer); + res = stat(path, sbuf); } - buffer->st_nlink = nlink; + sbuf->st_nlink = nlink; 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 + * sbuf->st_*time (but note that's not available on the * Windows of 1995) */ DWORD r; if (USING_WIDE()) { - r = GetFileAttributesW(wbuffer); + r = GetFileAttributesW(pwbuffer); } else { r = GetFileAttributesA(path); } if (r != 0xffffffff && (r & FILE_ATTRIBUTE_DIRECTORY)) { - /* buffer may still contain old garbage since stat() failed */ - Zero(buffer, 1, struct stat); - buffer->st_mode = S_IFDIR | S_IREAD; + /* sbuf may still contain old garbage since stat() failed */ + Zero(sbuf, 1, struct stat); + sbuf->st_mode = S_IFDIR | S_IREAD; errno = 0; if (!(r & FILE_ATTRIBUTE_READONLY)) - buffer->st_mode |= S_IWRITE | S_IEXEC; + sbuf->st_mode |= S_IWRITE | S_IEXEC; return 0; } } @@ -1117,28 +1213,32 @@ win32_stat(const char *path, struct stat *buffer) { /* The drive can be inaccessible, some _stat()s are buggy */ if (USING_WIDE() - ? !GetVolumeInformationW(wbuffer,NULL,0,NULL,NULL,NULL,NULL,0) + ? !GetVolumeInformationW(pwbuffer,NULL,0,NULL,NULL,NULL,NULL,0) : !GetVolumeInformationA(path,NULL,0,NULL,NULL,NULL,NULL,0)) { errno = ENOENT; return -1; } } #ifdef __BORLANDC__ - if (S_ISDIR(buffer->st_mode)) - buffer->st_mode |= S_IWRITE | S_IEXEC; - else if (S_ISREG(buffer->st_mode)) { + if (S_ISDIR(sbuf->st_mode)) + sbuf->st_mode |= S_IWRITE | S_IEXEC; + else if (S_ISREG(sbuf->st_mode)) { + int perms; if (l >= 4 && path[l-4] == '.') { const char *e = path + l - 3; if (strnicmp(e,"exe",3) && strnicmp(e,"bat",3) && strnicmp(e,"com",3) && (IsWin95() || strnicmp(e,"cmd",3))) - buffer->st_mode &= ~S_IEXEC; + sbuf->st_mode &= ~S_IEXEC; else - buffer->st_mode |= S_IEXEC; + sbuf->st_mode |= S_IEXEC; } else - buffer->st_mode &= ~S_IEXEC; + sbuf->st_mode &= ~S_IEXEC; + /* Propagate permissions to _group_ and _others_ */ + perms = sbuf->st_mode & (S_IREAD|S_IWRITE|S_IEXEC); + sbuf->st_mode |= (perms>>3) | (perms>>6); } #endif } @@ -1393,20 +1493,21 @@ win32_unlink(const char *filename) if (USING_WIDE()) { WCHAR wBuffer[MAX_PATH+1]; + WCHAR* pwBuffer; A2WHELPER(filename, wBuffer, sizeof(wBuffer)); - wcscpy(wBuffer, PerlDir_mapW(wBuffer)); - attrs = GetFileAttributesW(wBuffer); + pwBuffer = PerlDir_mapW(wBuffer); + attrs = GetFileAttributesW(pwBuffer); if (attrs == 0xFFFFFFFF) goto fail; if (attrs & FILE_ATTRIBUTE_READONLY) { - (void)SetFileAttributesW(wBuffer, attrs & ~FILE_ATTRIBUTE_READONLY); - ret = _wunlink(wBuffer); + (void)SetFileAttributesW(pwBuffer, attrs & ~FILE_ATTRIBUTE_READONLY); + ret = _wunlink(pwBuffer); if (ret == -1) - (void)SetFileAttributesW(wBuffer, attrs); + (void)SetFileAttributesW(pwBuffer, attrs); } else - ret = _wunlink(wBuffer); + ret = _wunlink(pwBuffer); } else { filename = PerlDir_mapA(filename); @@ -1438,12 +1539,13 @@ win32_utime(const char *filename, struct utimbuf *times) FILETIME ftWrite; struct utimbuf TimeBuffer; WCHAR wbuffer[MAX_PATH+1]; + WCHAR* pwbuffer; int rc; if (USING_WIDE()) { A2WHELPER(filename, wbuffer, sizeof(wbuffer)); - wcscpy(wbuffer, PerlDir_mapW(wbuffer)); - rc = _wutime(wbuffer, (struct _utimbuf*)times); + pwbuffer = PerlDir_mapW(wbuffer); + rc = _wutime(pwbuffer, (struct _utimbuf*)times); } else { filename = PerlDir_mapA(filename); @@ -1461,7 +1563,7 @@ win32_utime(const char *filename, struct utimbuf *times) /* This will (and should) still fail on readonly files */ if (USING_WIDE()) { - handle = CreateFileW(wbuffer, GENERIC_READ | GENERIC_WRITE, + handle = CreateFileW(pwbuffer, GENERIC_READ | GENERIC_WRITE, FILE_SHARE_READ | FILE_SHARE_DELETE, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); } @@ -1554,7 +1656,7 @@ win32_uname(struct utsname *name) char *arch; GetSystemInfo(&info); -#if defined(__BORLANDC__) || defined(__MINGW32__) +#if (defined(__BORLANDC__)&&(__BORLANDC__<=0x520)) || defined(__MINGW32__) switch (info.u.s.wProcessorArchitecture) { #else switch (info.wProcessorArchitecture) { @@ -1579,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]; @@ -1618,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; @@ -1655,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; } } } @@ -1690,6 +1819,8 @@ FAILED: return -1; } +#ifndef PERL_OBJECT + static UINT timerid = 0; static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time) @@ -1697,12 +1828,14 @@ static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time) dTHXo; KillTimer(NULL,timerid); timerid=0; - sighandler(14); + CALL_FPTR(PL_sighandlerp)(14); } +#endif /* !PERL_OBJECT */ DllExport unsigned int win32_alarm(unsigned int sec) { +#ifndef PERL_OBJECT /* * the 'obvious' implentation is SetTimer() with a callback * which does whatever receiving SIGALRM would do @@ -1727,6 +1860,7 @@ win32_alarm(unsigned int sec) timerid=0; } } +#endif /* !PERL_OBJECT */ return 0; } @@ -1739,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."); @@ -1747,56 +1880,10 @@ 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 */ +#define FNOINHERIT 0x10 /* file handle opened O_NOINHERIT */ #define FAPPEND 0x20 /* file handle opened O_APPEND */ #define FDEV 0x40 /* file handle refers to device */ #define FTEXT 0x80 /* file handle is in text mode */ @@ -1831,16 +1918,13 @@ 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 _alloc_osfhnd() +static int +_alloc_osfhnd(void) { HANDLE hF = CreateFile("NUL", 0, 0, NULL, OPEN_ALWAYS, 0, NULL); - int fh = _open_osfhandle(hF, 0); + int fh = _open_osfhandle((long)hF, 0); CloseHandle(hF); if (fh == -1) return fh; @@ -1863,6 +1947,9 @@ my_open_osfhandle(long osfhandle, int flags) if (flags & O_TEXT) fileflags |= FTEXT; + if (flags & O_NOINHERIT) + fileflags |= FNOINHERIT; + /* attempt to allocate a C Runtime file handle */ if ((fh = _alloc_osfhnd()) == -1) { errno = EMFILE; /* too many open files */ @@ -1876,7 +1963,7 @@ my_open_osfhandle(long osfhandle, int flags) fileflags |= FOPEN; /* mark as open */ _osfile(fh) = fileflags; /* set osfile entry */ - LeaveCritiicalSection(&_pioinfo(fh)->lock); + LeaveCriticalSection(&_pioinfo(fh)->lock); return fh; /* return handle */ } @@ -2041,7 +2128,6 @@ win32_str_os_error(void *sv, DWORD dwErr) } } - DllExport int win32_fprintf(FILE *fp, const char *format, ...) { @@ -2247,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 @@ -2258,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 @@ -2325,14 +2431,16 @@ win32_popen(const char *command, const char *mode) /* close saved handle */ win32_close(oldfd); + LOCK_FDPID_MUTEX; sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid); + 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 */ @@ -2352,7 +2460,7 @@ cleanup: */ DllExport int -win32_pclose(FILE *pf) +win32_pclose(PerlIO *pf) { #ifdef USE_RTL_POPEN return _pclose(pf); @@ -2361,7 +2469,9 @@ win32_pclose(FILE *pf) int childpid, status; SV *sv; - sv = *av_fetch(w32_fdpid, win32_fileno(pf), TRUE); + LOCK_FDPID_MUTEX; + sv = *av_fetch(w32_fdpid, PerlIO_fileno(pf), TRUE); + if (SvIOK(sv)) childpid = SvIVX(sv); else @@ -2372,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; @@ -2449,7 +2564,7 @@ win32_link(const char *oldname, const char *newname) WCHAR wNewName[MAX_PATH+1]; if (IsWin95()) - Perl_die(aTHX_ PL_no_func, "link"); + Perl_croak(aTHX_ PL_no_func, "link"); pfnCreateHardLinkW = (BOOL (__stdcall *)(LPCWSTR, LPCWSTR, LPSECURITY_ATTRIBUTES)) @@ -2633,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 @@ -2671,7 +2789,8 @@ win32_dup2(int fd1,int fd2) #define FTEXT 0x80 /* file handle is in text mode */ #define MAX_DESCRIPTOR_COUNT (64*32) /* this is the maximun that MSVCRT can handle */ -int __cdecl _fixed_read(int fh, void *buf, unsigned cnt) +int __cdecl +_fixed_read(int fh, void *buf, unsigned cnt) { int bytes_read; /* number of bytes read */ char *buffer; /* buffer to read to */ @@ -2691,7 +2810,12 @@ int __cdecl _fixed_read(int fh, void *buf, unsigned cnt) return -1; } - EnterCriticalSection(&(_pioinfo(fh)->lock)); /* lock file */ + /* + * If lockinitflag is FALSE, assume fd is device + * lockinitflag is set to TRUE by open. + */ + if (_pioinfo(fh)->lockinitflag) + EnterCriticalSection(&(_pioinfo(fh)->lock)); /* lock file */ bytes_read = 0; /* nothing read yet */ buffer = (char*)buf; @@ -2839,7 +2963,8 @@ int __cdecl _fixed_read(int fh, void *buf, unsigned cnt) } functionexit: - LeaveCriticalSection(&(_pioinfo(fh)->lock)); /* unlock file */ + if (_pioinfo(fh)->lockinitflag) + LeaveCriticalSection(&(_pioinfo(fh)->lock)); /* unlock file */ return bytes_read; } @@ -3101,6 +3226,7 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv) int ret; void* env; char* dir; + child_IO_table tbl; STARTUPINFO StartupInfo; PROCESS_INFORMATION ProcessInformation; DWORD create = 0; @@ -3129,9 +3255,20 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv) } memset(&StartupInfo,0,sizeof(StartupInfo)); StartupInfo.cb = sizeof(StartupInfo); - StartupInfo.hStdInput = GetStdHandle(STD_INPUT_HANDLE); - StartupInfo.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE); - StartupInfo.hStdError = GetStdHandle(STD_ERROR_HANDLE); + memset(&tbl,0,sizeof(tbl)); + PerlEnv_get_child_IO(&tbl); + StartupInfo.dwFlags = tbl.dwFlags; + StartupInfo.dwX = tbl.dwX; + StartupInfo.dwY = tbl.dwY; + StartupInfo.dwXSize = tbl.dwXSize; + StartupInfo.dwYSize = tbl.dwYSize; + StartupInfo.dwXCountChars = tbl.dwXCountChars; + StartupInfo.dwYCountChars = tbl.dwYCountChars; + StartupInfo.dwFillAttribute = tbl.dwFillAttribute; + StartupInfo.wShowWindow = tbl.wShowWindow; + StartupInfo.hStdInput = tbl.childStdIn; + StartupInfo.hStdOutput = tbl.childStdOut; + StartupInfo.hStdError = tbl.childStdErr; if (StartupInfo.hStdInput != INVALID_HANDLE_VALUE && StartupInfo.hStdOutput != INVALID_HANDLE_VALUE && StartupInfo.hStdError != INVALID_HANDLE_VALUE) @@ -3174,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 { @@ -3421,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)); @@ -3736,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); @@ -3766,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), @@ -3795,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), @@ -3881,18 +4049,6 @@ Perl_init_os_extras(void) 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; - w32_init_socktype = 0; -#ifdef USE_ITHREADS - w32_pseudo_id = 0; - New(1313, w32_pseudo_children, 1, child_tab); - w32_num_pseudo_children = 0; -#endif - /* these names are Activeware compatible */ newXS("Win32::GetCwd", w32_GetCwd, file); newXS("Win32::SetCwd", w32_SetCwd, file); @@ -3942,15 +4098,58 @@ Perl_win32_init(int *argcp, char ***argvp) MALLOC_INIT; } -#ifdef USE_ITHREADS +void +win32_get_child_IO(child_IO_table* ptbl) +{ + ptbl->childStdIn = GetStdHandle(STD_INPUT_HANDLE); + ptbl->childStdOut = GetStdHandle(STD_OUTPUT_HANDLE); + ptbl->childStdErr = GetStdHandle(STD_ERROR_HANDLE); +} + +#ifdef HAVE_INTERP_INTERN # ifdef PERL_OBJECT +# undef Perl_sys_intern_init +# 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 void +Perl_sys_intern_init(pTHX) +{ + w32_perlshell_tokens = Nullch; + w32_perlshell_vec = (char**)NULL; + w32_perlshell_items = 0; + w32_fdpid = newAV(); + New(1313, w32_children, 1, child_tab); + w32_num_children = 0; +# ifdef USE_ITHREADS + w32_pseudo_id = 0; + New(1313, w32_pseudo_children, 1, child_tab); + w32_num_pseudo_children = 0; +# endif + 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 Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst) { dst->perlshell_tokens = Nullch; @@ -3958,10 +4157,44 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst) dst->perlshell_items = 0; dst->fdpid = newAV(); Newz(1313, dst->children, 1, child_tab); - Newz(1313, dst->pseudo_children, 1, child_tab); dst->pseudo_id = 0; - dst->children->num = 0; - dst->thr_intern.Winit_socktype = src->thr_intern.Winit_socktype; + Newz(1313, dst->pseudo_children, 1, child_tab); + dst->thr_intern.Winit_socktype = 0; } +# endif /* USE_ITHREADS */ +#endif /* HAVE_INTERP_INTERN */ + +#ifdef PERL_OBJECT +# undef this +# define this pPerl #endif +static void +win32_free_argvw(pTHXo_ void *ptr) +{ + char** argv = (char**)ptr; + while(*argv) { + Safefree(*argv); + *argv++ = Nullch; + } +} + +void +win32_argv2utf8(int argc, char** argv) +{ + dTHXo; + char* psz; + int length, wargc; + LPWSTR* lpwStr = CommandLineToArgvW(GetCommandLineW(), &wargc); + if (lpwStr && argc) { + while (argc--) { + length = WideCharToMultiByte(CP_UTF8, 0, lpwStr[--wargc], -1, NULL, 0, NULL, NULL); + Newz(0, psz, length, char); + WideCharToMultiByte(CP_UTF8, 0, lpwStr[wargc], -1, psz, length, NULL, NULL); + argv[argc] = psz; + } + call_atexit(win32_free_argvw, argv); + } + GlobalFree((HGLOBAL)lpwStr); +} +