X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2Fwin32.c;h=41788273b732dc47bf4be9743e2b1eb98ce15f95;hb=abc0a0153433fe6596e1ca3a6b5572dc424d0f11;hp=40b7511296a5bef60414df500c4a362a88f6c868;hpb=05ec9bb346c404c8906ed1ac374d4bce61c84f5d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/win32/win32.c b/win32/win32.c index 40b7511..4178827 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -1,13 +1,13 @@ /* WIN32.C * - * (c) 1995 Microsoft Corporation. All rights reserved. + * (c) 1995 Microsoft Corporation. All rights reserved. * Developed by hip communications inc., http://info.hip.com/info/ * Portions (c) 1993 Intergraph Corporation. All rights reserved. * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. */ -#define PERLIO_NOT_STDIO 0 +#define PERLIO_NOT_STDIO 0 #define WIN32_LEAN_AND_MEAN #define WIN32IO_IS_STDIO #include @@ -54,7 +54,7 @@ #include #endif #ifdef __GNUC__ -/* Mingw32 defaults to globing command line +/* Mingw32 defaults to globing command line * So we turn it off like this: */ int _CRT_glob = 0; @@ -85,15 +85,13 @@ int _fcloseall(); # 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 # define getlogin g_getlogin #endif static void get_shell(void); static long tokenize(const char *str, char **dest, char ***destv); - int do_spawn2(char *cmd, int exectype); +static int do_spawn2(pTHX_ 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); @@ -118,7 +116,7 @@ static DWORD w32_platform = (DWORD)-1; #define ONE_K_BUFSIZE 1024 -int +int IsWin95(void) { return (win32_os_id() == VER_PLATFORM_WIN32_WINDOWS); @@ -208,7 +206,6 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...) char *ptr; char *optr; char *strip; - int oldsize, newsize; STRLEN baselen; va_start(ap, trailing_path); @@ -286,8 +283,6 @@ win32_get_xlib(const char *pl, const char *xlib, const char *libname) dTHX; char regstr[40]; char pathstr[MAX_PATH+1]; - DWORD datalen; - int len, newsize; SV *sv1 = Nullsv; SV *sv2 = Nullsv; @@ -519,12 +514,8 @@ get_shell(void) } int -do_aspawn(void *vreally, void **vmark, void **vsp) +Perl_do_aspawn(pTHX_ SV *really, SV **mark, SV **sp) { - dTHX; - SV *really = (SV*)vreally; - SV **mark = (SV**)vmark; - SV **sp = (SV**)vsp; char **argv; char *str; int status; @@ -549,7 +540,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp) argv[index++] = ""; } argv[index++] = 0; - + status = win32_spawnvp(flag, (const char*)(really ? SvPV_nolen(really) : argv[0]), (const char* const*)argv); @@ -562,7 +553,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp) argv[index+sh_items] = argv[index]; while (--sh_items >= 0) argv[sh_items] = w32_perlshell_vec[sh_items]; - + status = win32_spawnvp(flag, (const char*)(really ? SvPV_nolen(really) : argv[0]), (const char* const*)argv); @@ -575,7 +566,7 @@ do_aspawn(void *vreally, void **vmark, void **vsp) else { if (status < 0) { if (ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ WARN_EXEC, "Can't spawn \"%s\": %s", argv[0], strerror(errno)); + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't spawn \"%s\": %s", argv[0], strerror(errno)); status = 255 * 256; } else @@ -610,10 +601,9 @@ find_next_space(const char *s) return (char*)s; } -int -do_spawn2(char *cmd, int exectype) +static int +do_spawn2(pTHX_ char *cmd, int exectype) { - dTHX; char **a; char *s; char **argv; @@ -690,7 +680,7 @@ do_spawn2(char *cmd, int exectype) else { if (status < 0) { if (ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ WARN_EXEC, "Can't %s \"%s\": %s", + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s", (exectype == EXECF_EXEC ? "exec" : "spawn"), cmd, strerror(errno)); status = 255 * 256; @@ -703,21 +693,21 @@ do_spawn2(char *cmd, int exectype) } int -do_spawn(char *cmd) +Perl_do_spawn(pTHX_ char *cmd) { - return do_spawn2(cmd, EXECF_SPAWN); + return do_spawn2(aTHX_ cmd, EXECF_SPAWN); } int -do_spawn_nowait(char *cmd) +Perl_do_spawn_nowait(pTHX_ char *cmd) { - return do_spawn2(cmd, EXECF_SPAWN_NOWAIT); + return do_spawn2(aTHX_ cmd, EXECF_SPAWN_NOWAIT); } bool Perl_do_exec(pTHX_ char *cmd) { - do_spawn2(cmd, EXECF_EXEC); + do_spawn2(aTHX_ cmd, EXECF_EXEC); return FALSE; } @@ -733,7 +723,7 @@ win32_opendir(char *filename) long len; long idx; char scanname[MAX_PATH+3]; - struct stat sbuf; + Stat_t sbuf; WIN32_FIND_DATAA aFindData; WIN32_FIND_DATAW wFindData; HANDLE fh; @@ -881,7 +871,7 @@ win32_readdir(DIR *dirp) dirp->curr = NULL; } return &(dirp->dirstr); - } + } else return NULL; } @@ -963,7 +953,7 @@ getegid(void) int setuid(uid_t auid) -{ +{ return (auid == ROOT_UID ? 0 : -1); } @@ -1022,7 +1012,7 @@ find_pid(int pid) dTHX; long child = w32_num_children; while (--child >= 0) { - if (w32_child_pids[child] == pid) + if ((int)w32_child_pids[child] == pid) return child; } return -1; @@ -1049,7 +1039,7 @@ find_pseudo_pid(int pid) dTHX; long child = w32_num_pseudo_children; while (--child >= 0) { - if (w32_pseudo_child_pids[child] == pid) + if ((int)w32_pseudo_child_pids[child] == pid) return child; } return -1; @@ -1094,9 +1084,10 @@ win32_kill(int pid, int sig) } break; default: - /* We fake signals to pseudo-processes using Win32 message queue */ - if (PostThreadMessage(-pid,WM_USER,sig,0)) { - /* It might be us ... */ + /* We fake signals to pseudo-processes using Win32 + * message queue. In Win9X the pids are negative already. */ + if (PostThreadMessage(IsWin95() ? pid : -pid,WM_USER,sig,0)) { + /* It might be us ... */ PERL_ASYNC_CHECK(); return 0; } @@ -1159,10 +1150,10 @@ alien_process: } DllExport int -win32_stat(const char *path, struct stat *sbuf) +win32_stat(const char *path, Stat_t *sbuf) { dTHX; - char buffer[MAX_PATH+1]; + char buffer[MAX_PATH+1]; int l = strlen(path); int res; WCHAR wbuffer[MAX_PATH+1]; @@ -1216,10 +1207,18 @@ win32_stat(const char *path, struct stat *sbuf) /* pwbuffer or path will be mapped correctly above */ if (USING_WIDE()) { - res = _wstat(pwbuffer, (struct _stat *)sbuf); +#if defined(WIN64) || defined(USE_LARGE_FILES) + res = _wstati64(pwbuffer, sbuf); +#else + res = _wstat(pwbuffer, (struct _stat*)sbuf); +#endif } else { +#if defined(WIN64) || defined(USE_LARGE_FILES) + res = _stati64(path, sbuf); +#else res = stat(path, sbuf); +#endif } sbuf->st_nlink = nlink; @@ -1237,7 +1236,7 @@ win32_stat(const char *path, struct stat *sbuf) } if (r != 0xffffffff && (r & FILE_ATTRIBUTE_DIRECTORY)) { /* sbuf may still contain old garbage since stat() failed */ - Zero(sbuf, 1, struct stat); + Zero(sbuf, 1, Stat_t); sbuf->st_mode = S_IFDIR | S_IREAD; errno = 0; if (!(r & FILE_ATTRIBUTE_READONLY)) @@ -1283,6 +1282,18 @@ win32_stat(const char *path, struct stat *sbuf) return res; } +#define isSLASH(c) ((c) == '/' || (c) == '\\') +#define SKIP_SLASHES(s) \ + STMT_START { \ + while (*(s) && isSLASH(*(s))) \ + ++(s); \ + } STMT_END +#define COPY_NONSLASHES(d,s) \ + STMT_START { \ + while (*(s) && !isSLASH(*(s))) \ + *(d)++ = *(s)++; \ + } STMT_END + /* Find the longname of a given path. path is destructively modified. * It should have space for at least MAX_PATH characters. */ DllExport char * @@ -1298,61 +1309,74 @@ win32_longpath(char *path) return Nullch; /* drive prefix */ - if (isALPHA(path[0]) && path[1] == ':' && - (path[2] == '/' || path[2] == '\\')) - { + if (isALPHA(path[0]) && path[1] == ':') { start = path + 2; *tmpstart++ = path[0]; *tmpstart++ = ':'; } /* UNC prefix */ - else if ((path[0] == '/' || path[0] == '\\') && - (path[1] == '/' || path[1] == '\\')) - { + else if (isSLASH(path[0]) && isSLASH(path[1])) { start = path + 2; *tmpstart++ = path[0]; *tmpstart++ = path[1]; - /* copy machine name */ - while (*start && *start != '/' && *start != '\\') - *tmpstart++ = *start++; + SKIP_SLASHES(start); + COPY_NONSLASHES(tmpstart,start); /* copy machine name */ if (*start) { - *tmpstart++ = *start; - start++; - /* copy share name */ - while (*start && *start != '/' && *start != '\\') - *tmpstart++ = *start++; + *tmpstart++ = *start++; + SKIP_SLASHES(start); + COPY_NONSLASHES(tmpstart,start); /* copy share name */ } } - sep = *start++; - if (sep == '/' || sep == '\\') - *tmpstart++ = sep; *tmpstart = '\0'; - while (sep) { - /* walk up to slash */ - while (*start && *start != '/' && *start != '\\') - ++start; + while (*start) { + /* copy initial slash, if any */ + if (isSLASH(*start)) { + *tmpstart++ = *start++; + *tmpstart = '\0'; + SKIP_SLASHES(start); + } - /* discard doubled slashes */ - while (*start && (start[1] == '/' || start[1] == '\\')) + /* FindFirstFile() expands "." and "..", so we need to pass + * those through unmolested */ + if (*start == '.' + && (!start[1] || isSLASH(start[1]) + || (start[1] == '.' && (!start[2] || isSLASH(start[2]))))) + { + COPY_NONSLASHES(tmpstart,start); /* copy "." or ".." */ + *tmpstart = '\0'; + continue; + } + + /* if this is the end, bust outta here */ + if (!*start) + break; + + /* now we're at a non-slash; walk up to next slash */ + while (*start && !isSLASH(*start)) ++start; - sep = *start; /* stop and find full name of component */ + sep = *start; *start = '\0'; fhand = FindFirstFile(path,&fdata); + *start = sep; if (fhand != INVALID_HANDLE_VALUE) { - strcpy(tmpstart, fdata.cFileName); - tmpstart += strlen(fdata.cFileName); - if (sep) - *tmpstart++ = sep; - *tmpstart = '\0'; - *start++ = sep; - FindClose(fhand); + STRLEN len = strlen(fdata.cFileName); + if ((STRLEN)(tmpbuf + sizeof(tmpbuf) - tmpstart) > len) { + strcpy(tmpstart, fdata.cFileName); + tmpstart += len; + FindClose(fhand); + } + else { + FindClose(fhand); + errno = ERANGE; + return Nullch; + } } else { /* failed a step, just return without side effects */ /*PerlIO_printf(Perl_debug_log, "Failed to find %s\n", path);*/ - *start = sep; + errno = EINVAL; return Nullch; } } @@ -1477,22 +1501,21 @@ win32_times(struct tms *timebuf) FILETIME user; FILETIME kernel; FILETIME dummy; - if (GetProcessTimes(GetCurrentProcess(), &dummy, &dummy, + clock_t process_time_so_far = clock(); + if (GetProcessTimes(GetCurrentProcess(), &dummy, &dummy, &kernel,&user)) { timebuf->tms_utime = filetime_to_clock(&user); timebuf->tms_stime = filetime_to_clock(&kernel); timebuf->tms_cutime = 0; timebuf->tms_cstime = 0; - - } else { + } else { /* That failed - e.g. Win95 fallback to clock() */ - clock_t t = clock(); - timebuf->tms_utime = t; + timebuf->tms_utime = process_time_so_far; timebuf->tms_stime = 0; timebuf->tms_cutime = 0; timebuf->tms_cstime = 0; } - return 0; + return process_time_so_far; } /* fix utime() so it works on directories in NT */ @@ -1621,6 +1644,38 @@ win32_utime(const char *filename, struct utimbuf *times) return rc; } +typedef union { + unsigned __int64 ft_i64; + FILETIME ft_val; +} FT_t; + +#ifdef __GNUC__ +#define Const64(x) x##LL +#else +#define Const64(x) x##i64 +#endif +/* Number of 100 nanosecond units from 1/1/1601 to 1/1/1970 */ +#define EPOCH_BIAS Const64(116444736000000000) + +/* NOTE: This does not compute the timezone info (doing so can be expensive, + * and appears to be unsupported even by glibc) */ +DllExport int +win32_gettimeofday(struct timeval *tp, void *not_used) +{ + FT_t ft; + + /* this returns time in 100-nanosecond units (i.e. tens of usecs) */ + GetSystemTimeAsFileTime(&ft.ft_val); + + /* seconds since epoch */ + tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(10000000)); + + /* microseconds remaining */ + tp->tv_usec = (long)((ft.ft_i64 / Const64(10)) % Const64(1000000)); + + return 0; +} + DllExport int win32_uname(struct utsname *name) { @@ -1687,15 +1742,17 @@ win32_uname(struct utsname *name) /* machine (architecture) */ { SYSTEM_INFO info; + DWORD procarch; char *arch; GetSystemInfo(&info); #if (defined(__BORLANDC__)&&(__BORLANDC__<=0x520)) \ || (defined(__MINGW32__) && !defined(_ANONYMOUS_UNION)) - switch (info.u.s.wProcessorArchitecture) { + procarch = info.u.s.wProcessorArchitecture; #else - switch (info.wProcessorArchitecture) { + procarch = info.wProcessorArchitecture; #endif + switch (procarch) { case PROCESSOR_ARCHITECTURE_INTEL: arch = "x86"; break; case PROCESSOR_ARCHITECTURE_MIPS: @@ -1704,16 +1761,94 @@ win32_uname(struct utsname *name) arch = "alpha"; break; case PROCESSOR_ARCHITECTURE_PPC: arch = "ppc"; break; - default: +#ifdef PROCESSOR_ARCHITECTURE_SHX + case PROCESSOR_ARCHITECTURE_SHX: + arch = "shx"; break; +#endif +#ifdef PROCESSOR_ARCHITECTURE_ARM + case PROCESSOR_ARCHITECTURE_ARM: + arch = "arm"; break; +#endif +#ifdef PROCESSOR_ARCHITECTURE_IA64 + case PROCESSOR_ARCHITECTURE_IA64: + arch = "ia64"; break; +#endif +#ifdef PROCESSOR_ARCHITECTURE_ALPHA64 + case PROCESSOR_ARCHITECTURE_ALPHA64: + arch = "alpha64"; break; +#endif +#ifdef PROCESSOR_ARCHITECTURE_MSIL + case PROCESSOR_ARCHITECTURE_MSIL: + arch = "msil"; break; +#endif +#ifdef PROCESSOR_ARCHITECTURE_AMD64 + case PROCESSOR_ARCHITECTURE_AMD64: + arch = "amd64"; break; +#endif +#ifdef PROCESSOR_ARCHITECTURE_IA32_ON_WIN64 + case PROCESSOR_ARCHITECTURE_IA32_ON_WIN64: + arch = "ia32-64"; break; +#endif +#ifdef PROCESSOR_ARCHITECTURE_UNKNOWN + case PROCESSOR_ARCHITECTURE_UNKNOWN: arch = "unknown"; break; +#endif + default: + sprintf(name->machine, "unknown(0x%x)", procarch); + arch = name->machine; + break; } - strcpy(name->machine, arch); + if (name->machine != arch) + strcpy(name->machine, arch); } return 0; } /* Timing related stuff */ +int +do_raise(pTHX_ int sig) +{ + if (sig < SIG_SIZE) { + Sighandler_t handler = w32_sighandler[sig]; + if (handler == SIG_IGN) { + return 0; + } + else if (handler != SIG_DFL) { + (*handler)(sig); + return 0; + } + else { + /* Choose correct default behaviour */ + switch (sig) { +#ifdef SIGCLD + case SIGCLD: +#endif +#ifdef SIGCHLD + case SIGCHLD: +#endif + case 0: + return 0; + case SIGTERM: + default: + break; + } + } + } + /* Tell caller to exit thread/process as approriate */ + return 1; +} + +void +sig_terminate(pTHX_ int sig) +{ + Perl_warn(aTHX_ "Terminating on signal SIG%s(%d)\n",PL_sig_name[sig], sig); + /* exit() seems to be safe, my_exit() or die() is a problem in ^C + thread + */ + exit(sig); +} + DllExport int win32_async_check(pTHX) { @@ -1721,33 +1856,41 @@ win32_async_check(pTHX) int ours = 1; /* Passing PeekMessage -1 as HWND (2nd arg) only get PostThreadMessage() messages * and ignores window messages - should co-exist better with windows apps e.g. Tk - */ + */ while (PeekMessage(&msg, (HWND)-1, 0, 0, PM_REMOVE|PM_NOYIELD)) { + int sig; switch(msg.message) { #if 0 /* Perhaps some other messages could map to signals ? ... */ case WM_CLOSE: - case WM_QUIT: + case WM_QUIT: /* Treat WM_QUIT like SIGHUP? */ - CALL_FPTR(PL_sighandlerp)(1); + sig = SIGHUP; + goto Raise; break; #endif /* We use WM_USER to fake kill() with other signals */ case WM_USER: { - CALL_FPTR(PL_sighandlerp)(msg.wParam); + sig = msg.wParam; + Raise: + if (do_raise(aTHX_ sig)) { + sig_terminate(aTHX_ sig); + } break; } - + case WM_TIMER: { /* alarm() is a one-shot but SetTimer() repeats so kill it */ if (w32_timerid) { KillTimer(NULL,w32_timerid); - w32_timerid=0; - } + w32_timerid=0; + } /* Now fake a call to signal handler */ - CALL_FPTR(PL_sighandlerp)(14); + if (do_raise(aTHX_ 14)) { + sig_terminate(aTHX_ 14); + } break; } @@ -1765,7 +1908,7 @@ win32_async_check(pTHX) if (PL_sig_pending) { despatch_signals(); } - return ours; + return ours; } DllExport DWORD @@ -1782,9 +1925,9 @@ win32_msgwait(pTHX_ DWORD count, LPHANDLE handles, DWORD timeout, LPDWORD result if (resultp) *resultp = result; if (result == WAIT_TIMEOUT) { - /* Ran out of time - explicit return of zero to avoid -ve if we - have scheduling issues - */ + /* Ran out of time - explicit return of zero to avoid -ve if we + have scheduling issues + */ return 0; } if (timeout != INFINITE) { @@ -1868,7 +2011,6 @@ win32_internal_wait(int *status, DWORD timeout) } } -FAILED: errno = GetLastError(); return -1; } @@ -1952,7 +2094,7 @@ alien_process: errno = ECHILD; } } - return retval >= 0 ? pid : retval; + return retval >= 0 ? pid : retval; } DllExport int @@ -1972,12 +2114,12 @@ win32_sleep(unsigned int t) DllExport unsigned int win32_alarm(unsigned int sec) { - /* + /* * the 'obvious' implentation is SetTimer() with a callback - * which does whatever receiving SIGALRM would do - * we cannot use SIGALRM even via raise() as it is not + * which does whatever receiving SIGALRM would do + * we cannot use SIGALRM even via raise() as it is not * one of the supported codes in - */ + */ dTHX; if (sec) { w32_timerid = SetTimer(NULL,w32_timerid,sec*1000,NULL); @@ -1985,9 +2127,9 @@ win32_alarm(unsigned int sec) else { if (w32_timerid) { KillTimer(NULL,w32_timerid); - w32_timerid=0; + w32_timerid=0; } - } + } return 0; } @@ -2016,7 +2158,7 @@ win32_crypt(const char *txt, const char *salt) #define FTEXT 0x80 /* file handle is in text mode */ /*** -*int my_open_osfhandle(long osfhandle, int flags) - open C Runtime file handle +*int my_open_osfhandle(intptr_t osfhandle, int flags) - open C Runtime file handle * *Purpose: * This function allocates a free C Runtime file handle and associates @@ -2027,7 +2169,7 @@ win32_crypt(const char *txt, const char *salt) * This works with MSVC++ 4.0+ or GCC/Mingw32 * *Entry: -* long osfhandle - Win32 HANDLE to associate with C Runtime file handle. +* intptr_t osfhandle - Win32 HANDLE to associate with C Runtime file handle. * int flags - flags to associate with C Runtime file handle. * *Exit: @@ -2051,7 +2193,7 @@ static int _alloc_osfhnd(void) { HANDLE hF = CreateFile("NUL", 0, 0, NULL, OPEN_ALWAYS, 0, NULL); - int fh = _open_osfhandle((long)hF, 0); + int fh = _open_osfhandle((intptr_t)hF, 0); CloseHandle(hF); if (fh == -1) return fh; @@ -2060,7 +2202,7 @@ _alloc_osfhnd(void) } static int -my_open_osfhandle(long osfhandle, int flags) +my_open_osfhandle(intptr_t osfhandle, int flags) { int fh; char fileflags; /* _osfile flags */ @@ -2195,13 +2337,13 @@ win32_feof(FILE *fp) } /* - * Since the errors returned by the socket error function + * Since the errors returned by the socket error function * WSAGetLastError() are not known by the library routine strerror * we have to roll our own. */ DllExport char * -win32_strerror(int e) +win32_strerror(int e) { #if !defined __BORLANDC__ && !defined __MINGW32__ /* compiler intolerance */ extern int sys_nerr; @@ -2215,7 +2357,7 @@ win32_strerror(int e) if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0, w32_strerror_buffer, - sizeof(w32_strerror_buffer), NULL) == 0) + sizeof(w32_strerror_buffer), NULL) == 0) strcpy(w32_strerror_buffer, "Unknown Error"); return w32_strerror_buffer; @@ -2305,7 +2447,7 @@ win32_fopen(const char *filename, const char *mode) dTHX; WCHAR wMode[MODE_SIZE], wBuffer[MAX_PATH+1]; FILE *f; - + if (!*filename) return NULL; @@ -2413,16 +2555,45 @@ win32_fflush(FILE *pf) return fflush(pf); } -DllExport long +DllExport Off_t win32_ftell(FILE *pf) { +#if defined(WIN64) || defined(USE_LARGE_FILES) + fpos_t pos; + if (fgetpos(pf, &pos)) + return -1; + return (Off_t)pos; +#else return ftell(pf); +#endif } DllExport int -win32_fseek(FILE *pf,long offset,int origin) +win32_fseek(FILE *pf, Off_t offset,int origin) { +#if defined(WIN64) || defined(USE_LARGE_FILES) + fpos_t pos; + switch (origin) { + case SEEK_CUR: + if (fgetpos(pf, &pos)) + return -1; + offset += pos; + break; + case SEEK_END: + fseek(pf, 0, SEEK_END); + pos = _telli64(fileno(pf)); + offset += pos; + break; + case SEEK_SET: + break; + default: + errno = EINVAL; + return -1; + } + return fsetpos(pf, &offset); +#else return fseek(pf, offset, origin); +#endif } DllExport int @@ -2462,8 +2633,11 @@ win32_tmpfile(void) | FILE_FLAG_DELETE_ON_CLOSE, NULL); if (fh != INVALID_HANDLE_VALUE) { - int fd = win32_open_osfhandle((long)fh, 0); + int fd = win32_open_osfhandle((intptr_t)fh, 0); if (fd >= 0) { +#if defined(__BORLANDC__) + setmode(fd,O_BINARY); +#endif DEBUG_p(PerlIO_printf(Perl_debug_log, "Created tmpfile=%s\n",filename)); return fdopen(fd, "w+b"); @@ -2482,13 +2656,13 @@ win32_abort(void) } DllExport int -win32_fstat(int fd,struct stat *sbufptr) +win32_fstat(int fd, Stat_t *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)) { @@ -2531,22 +2705,28 @@ win32_popen(const char *command, const char *mode) #ifdef USE_RTL_POPEN return _popen(command, mode); #else + dTHX; int p[2]; int parent, child; int stdfd, oldfd; int ourmode; int childpid; + DWORD nhandle; + HANDLE old_h; + int lock_held = 0; /* establish which ends read and write */ if (strchr(mode,'w')) { stdfd = 0; /* stdin */ parent = 1; child = 0; + nhandle = STD_INPUT_HANDLE; } else if (strchr(mode,'r')) { stdfd = 1; /* stdout */ parent = 0; child = 1; + nhandle = STD_OUTPUT_HANDLE; } else return NULL; @@ -2562,7 +2742,7 @@ win32_popen(const char *command, const char *mode) /* the child doesn't inherit handles */ ourmode |= O_NOINHERIT; - if (win32_pipe( p, 512, ourmode) == -1) + if (win32_pipe(p, 512, ourmode) == -1) return NULL; /* save current stdfd */ @@ -2577,12 +2757,25 @@ win32_popen(const char *command, const char *mode) /* close the child end in parent */ win32_close(p[child]); + /* save the old std handle, and set the std handle */ + OP_REFCNT_LOCK; + lock_held = 1; + old_h = GetStdHandle(nhandle); + SetStdHandle(nhandle, (HANDLE)_get_osfhandle(stdfd)); + /* start the child */ { dTHX; if ((childpid = do_spawn_nowait((char*)command)) == -1) goto cleanup; + /* restore the old std handle */ + if (lock_held) { + SetStdHandle(nhandle, old_h); + OP_REFCNT_UNLOCK; + lock_held = 0; + } + /* revert stdfd to whatever it was before */ if (win32_dup2(oldfd, stdfd) == -1) goto cleanup; @@ -2605,6 +2798,11 @@ cleanup: /* we don't need to check for errors here */ win32_close(p[0]); win32_close(p[1]); + if (lock_held) { + SetStdHandle(nhandle, old_h); + OP_REFCNT_UNLOCK; + lock_held = 0; + } if (oldfd != -1) { win32_dup2(oldfd, stdfd); win32_close(oldfd); @@ -2874,16 +3072,24 @@ win32_setmode(int fd, int mode) return setmode(fd, mode); } -DllExport long -win32_lseek(int fd, long offset, int origin) +DllExport Off_t +win32_lseek(int fd, Off_t offset, int origin) { +#if defined(WIN64) || defined(USE_LARGE_FILES) + return _lseeki64(fd, offset, origin); +#else return lseek(fd, offset, origin); +#endif } -DllExport long +DllExport Off_t win32_tell(int fd) { +#if defined(WIN64) || defined(USE_LARGE_FILES) + return _telli64(fd); +#else return tell(fd); +#endif } DllExport int @@ -3122,7 +3328,7 @@ _fixed_read(int fh, void *buf, unsigned cnt) bytes_read = q - (char *)buf; } -functionexit: +functionexit: if (_pioinfo(fh)->lockinitflag) LeaveCriticalSection(&(_pioinfo(fh)->lock)); /* unlock file */ @@ -3427,7 +3633,7 @@ qualified_path(const char *cmd) if (*pathstr == '"') { /* foo;"baz;etc";bar */ pathstr++; /* skip initial '"' */ while (*pathstr && *pathstr != '"') { - if (curfullcmd-fullcmd < MAX_PATH-cmdlen-5) + if ((STRLEN)(curfullcmd-fullcmd) < MAX_PATH-cmdlen-5) *curfullcmd++ = *pathstr; pathstr++; } @@ -3435,7 +3641,7 @@ qualified_path(const char *cmd) pathstr++; /* skip trailing '"' */ } else { - if (curfullcmd-fullcmd < MAX_PATH-cmdlen-5) + if ((STRLEN)(curfullcmd-fullcmd) < MAX_PATH-cmdlen-5) *curfullcmd++ = *pathstr; pathstr++; } @@ -3448,7 +3654,7 @@ qualified_path(const char *cmd) *curfullcmd++ = '\\'; } } -GIVE_UP: + Safefree(fullcmd); return Nullch; } @@ -3524,7 +3730,7 @@ win32_free_childdir(char* d) * 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. */ @@ -3578,10 +3784,10 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv) ret = -1; goto RETVAL; } - /* Create a new process group so we can use GenerateConsoleCtrlEvent() + /* Create a new process group so we can use GenerateConsoleCtrlEvent() * in win32_kill() */ - create |= CREATE_NEW_PROCESS_GROUP; + create |= CREATE_NEW_PROCESS_GROUP; /* FALL THROUGH */ case P_WAIT: /* synchronous execution */ @@ -3596,25 +3802,29 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv) 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.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) + if (StartupInfo.hStdInput == INVALID_HANDLE_VALUE && + StartupInfo.hStdOutput == INVALID_HANDLE_VALUE && + StartupInfo.hStdError == INVALID_HANDLE_VALUE) { - StartupInfo.dwFlags |= STARTF_USESTDHANDLES; + create |= CREATE_NEW_CONSOLE; } else { - create |= CREATE_NEW_CONSOLE; + StartupInfo.dwFlags |= STARTF_USESTDHANDLES; + } + if (w32_use_showwindow) { + StartupInfo.dwFlags |= STARTF_USESHOWWINDOW; + StartupInfo.wShowWindow = w32_showwindow; } DEBUG_p(PerlIO_printf(Perl_debug_log, "Spawning [%s] with [%s]\n", @@ -3804,7 +4014,7 @@ static DWORD pagesize = 0; /* XXX threadead */ static DWORD allocsize = 0; /* XXX threadead */ void * -sbrk(int need) +sbrk(ptrdiff_t need) { void *result; if (!pagesize) @@ -3817,7 +4027,7 @@ sbrk(int need) allocsize = info.dwAllocationGranularity; } /* This scheme fails eventually if request for contiguous - * block is denied so reserve big blocks - this is only + * block is denied so reserve big blocks - this is only * address space not memory ... */ if (brk+need >= reserved) @@ -3831,7 +4041,7 @@ sbrk(int need) if (addr) committed = reserved; } - /* Reserve some (more) space + /* Reserve some (more) space * Note this is a little sneaky, 1st call passes NULL as reserved * so lets system choose where we start, subsequent calls pass * the old end address so ask for a contiguous block @@ -3896,8 +4106,8 @@ win32_free(void *block) } -int -win32_open_osfhandle(long handle, int flags) +DllExport int +win32_open_osfhandle(intptr_t handle, int flags) { #ifdef USE_FIXED_OSFHANDLE if (IsWin95()) @@ -3906,10 +4116,62 @@ win32_open_osfhandle(long handle, int flags) return _open_osfhandle(handle, flags); } -long +DllExport intptr_t win32_get_osfhandle(int fd) { - return _get_osfhandle(fd); + return (intptr_t)_get_osfhandle(fd); +} + +DllExport FILE * +win32_fdupopen(FILE *pf) +{ + FILE* pfdup; + fpos_t pos; + char mode[3]; + int fileno = win32_dup(win32_fileno(pf)); + + /* open the file in the same mode */ +#ifdef __BORLANDC__ + if((pf)->flags & _F_READ) { + mode[0] = 'r'; + mode[1] = 0; + } + else if((pf)->flags & _F_WRIT) { + mode[0] = 'a'; + mode[1] = 0; + } + else if((pf)->flags & _F_RDWR) { + mode[0] = 'r'; + mode[1] = '+'; + mode[2] = 0; + } +#else + if((pf)->_flag & _IOREAD) { + mode[0] = 'r'; + mode[1] = 0; + } + else if((pf)->_flag & _IOWRT) { + mode[0] = 'a'; + mode[1] = 0; + } + else if((pf)->_flag & _IORW) { + mode[0] = 'r'; + mode[1] = '+'; + mode[2] = 0; + } +#endif + + /* it appears that the binmode is attached to the + * file descriptor so binmode files will be handled + * correctly + */ + pfdup = win32_fdopen(fileno, mode); + + /* move the file pointer to the same position */ + if (!fgetpos(pf, &pos)) { + fsetpos(pfdup, &pos); + } + return pfdup; } DllExport void* @@ -3952,15 +4214,41 @@ win32_dynaload(const char* filename) */ static +XS(w32_SetChildShowWindow) +{ + dXSARGS; + BOOL use_showwindow = w32_use_showwindow; + /* use "unsigned short" because Perl has redefined "WORD" */ + unsigned short showwindow = w32_showwindow; + + if (items > 1) + Perl_croak(aTHX_ "usage: Win32::SetChildShowWindow($showwindow)"); + + if (items == 0 || !SvOK(ST(0))) + w32_use_showwindow = FALSE; + else { + w32_use_showwindow = TRUE; + w32_showwindow = (unsigned short)SvIV(ST(0)); + } + + EXTEND(SP, 1); + if (use_showwindow) + ST(0) = sv_2mortal(newSViv(showwindow)); + else + ST(0) = &PL_sv_undef; + XSRETURN(1); +} + +static XS(w32_GetCwd) { dXSARGS; /* Make the host for current directory */ char* ptr = PerlEnv_get_childdir(); - /* - * If ptr != Nullch - * then it worked, set PV valid, - * else return 'undef' + /* + * If ptr != Nullch + * then it worked, set PV valid, + * else return 'undef' */ if (ptr) { SV *sv = sv_newmortal(); @@ -4437,6 +4725,7 @@ Perl_init_os_extras(void) newXS("Win32::GetLongPathName", w32_GetLongPathName, file); newXS("Win32::CopyFile", w32_CopyFile, file); newXS("Win32::Sleep", w32_Sleep, file); + newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file); /* XXX Bloat Alert! The following Activeware preloads really * ought to be part of Win32::Sys::*, so they're not included @@ -4450,64 +4739,81 @@ Perl_init_os_extras(void) */ } -PerlInterpreter * +void * win32_signal_context(void) { dTHX; +#ifdef MULTIPLICITY if (!my_perl) { my_perl = PL_curinterp; PERL_SET_THX(my_perl); - } + } return my_perl; +#else +#ifdef USE_5005THREADS + return aTHX; +#else + return PL_curinterp; +#endif +#endif } -BOOL WINAPI + +BOOL WINAPI win32_ctrlhandler(DWORD dwCtrlType) { +#ifdef MULTIPLICITY dTHXa(PERL_GET_SIG_CONTEXT); if (!my_perl) return FALSE; +#else +#ifdef USE_5005THREADS + dTHX; +#endif +#endif switch(dwCtrlType) { case CTRL_CLOSE_EVENT: - /* A signal that the system sends to all processes attached to a console when - the user closes the console (either by choosing the Close command from the - console window's System menu, or by choosing the End Task command from the + /* A signal that the system sends to all processes attached to a console when + the user closes the console (either by choosing the Close command from the + console window's System menu, or by choosing the End Task command from the Task List */ - CALL_FPTR(PL_sighandlerp)(1); /* SIGHUP */ - return TRUE; + if (do_raise(aTHX_ 1)) /* SIGHUP */ + sig_terminate(aTHX_ 1); + return TRUE; case CTRL_C_EVENT: /* A CTRL+c signal was received */ - CALL_FPTR(PL_sighandlerp)(SIGINT); /* SIGINT */ - return TRUE; + if (do_raise(aTHX_ SIGINT)) + sig_terminate(aTHX_ SIGINT); + return TRUE; case CTRL_BREAK_EVENT: /* A CTRL+BREAK signal was received */ - CALL_FPTR(PL_sighandlerp)(SIGBREAK); /* unix calls it SIGQUIT */ - return TRUE; + if (do_raise(aTHX_ SIGBREAK)) + sig_terminate(aTHX_ SIGBREAK); + return TRUE; case CTRL_LOGOFF_EVENT: - /* A signal that the system sends to all console processes when a user is logging - off. This signal does not indicate which user is logging off, so no - assumptions can be made. + /* A signal that the system sends to all console processes when a user is logging + off. This signal does not indicate which user is logging off, so no + assumptions can be made. */ - break; + break; case CTRL_SHUTDOWN_EVENT: - /* A signal that the system sends to all console processes when the system is - shutting down. + /* A signal that the system sends to all console processes when the system is + shutting down. */ - CALL_FPTR(PL_sighandlerp)(SIGTERM); - return TRUE; - break; + if (do_raise(aTHX_ SIGTERM)) + sig_terminate(aTHX_ SIGTERM); + return TRUE; default: - break; + break; } return FALSE; } - void @@ -4533,6 +4839,27 @@ win32_get_child_IO(child_IO_table* ptbl) ptbl->childStdErr = GetStdHandle(STD_ERROR_HANDLE); } +Sighandler_t +win32_signal(int sig, Sighandler_t subcode) +{ + dTHX; + if (sig < SIG_SIZE) { + int save_errno = errno; + Sighandler_t result = signal(sig, subcode); + if (result == SIG_ERR) { + result = w32_sighandler[sig]; + errno = save_errno; + } + w32_sighandler[sig] = subcode; + return result; + } + else { + errno = EINVAL; + return SIG_ERR; + } +} + + #ifdef HAVE_INTERP_INTERN @@ -4549,6 +4876,7 @@ win32_csighandler(int sig) void Perl_sys_intern_init(pTHX) { + int i; w32_perlshell_tokens = Nullch; w32_perlshell_vec = (char**)NULL; w32_perlshell_items = 0; @@ -4563,11 +4891,18 @@ Perl_sys_intern_init(pTHX) w32_init_socktype = 0; w32_timerid = 0; w32_poll_count = 0; + for (i=0; i < SIG_SIZE; i++) { + w32_sighandler[i] = SIG_DFL; + } +# ifdef MULTIPLICTY if (my_perl == PL_curinterp) { - /* Force C runtime signal stuff to set its console handler */ +# else + { +# endif + /* Force C runtime signal stuff to set its console handler */ signal(SIGINT,&win32_csighandler); signal(SIGBREAK,&win32_csighandler); - /* Push our handler on top */ + /* Push our handler on top */ SetConsoleCtrlHandler(win32_ctrlhandler,TRUE); } } @@ -4581,9 +4916,13 @@ Perl_sys_intern_clear(pTHX) Safefree(w32_children); if (w32_timerid) { KillTimer(NULL,w32_timerid); - w32_timerid=0; + w32_timerid=0; } +# ifdef MULTIPLICITY if (my_perl == PL_curinterp) { +# else + { +# endif SetConsoleCtrlHandler(win32_ctrlhandler,FALSE); } # ifdef USE_ITHREADS @@ -4606,6 +4945,7 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst) dst->thr_intern.Winit_socktype = 0; dst->timerid = 0; dst->poll_count = 0; + Copy(src->sigtable,dst->sigtable,SIG_SIZE,Sighandler_t); } # endif /* USE_ITHREADS */ #endif /* HAVE_INTERP_INTERN */ @@ -4638,7 +4978,3 @@ win32_argv2utf8(int argc, char** argv) } GlobalFree((HGLOBAL)lpwStr); } - - - -