/* 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 WIN32_LEAN_AND_MEAN
#define WIN32IO_IS_STDIO
#include <tchar.h>
#define Win32_Winsock
#endif
#include <windows.h>
-#ifndef __MINGW32__ /* GCC/Mingw32-2.95.2 forgot the WINAPI on CommandLineToArgvW() */
+/* GCC-2.95.2/Mingw32-1.1 forgot the WINAPI on CommandLineToArgvW() */
+#if defined(__MINGW32__) && (__MINGW32_MAJOR_VERSION==1)
# include <shellapi.h>
#else
LPWSTR* WINAPI CommandLineToArgvW(LPCWSTR lpCommandLine, int * pNumArgs);
#endif
#include <winnt.h>
#include <io.h>
+#include <signal.h>
/* #include "config.h" */
-#define PERLIO_NOT_STDIO 0
#if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
#define PerlIO FILE
#endif
#include <utime.h>
#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;
#endif
-#if defined(__MINGW32__)
-/* Mingw32 is missing some prototypes */
+#if defined(__MINGW32__) && (__MINGW32_MAJOR_VERSION==1)
+/* Mingw32-1.1 is missing some prototypes */
FILE * _wfopen(LPCWSTR wszFileName, LPCWSTR wszMode);
FILE * _wfdopen(int nFd, LPCWSTR wszMode);
FILE * _freopen(LPCWSTR wszFileName, LPCWSTR wszMode, FILE * pOldStream);
# 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);
#define ONE_K_BUFSIZE 1024
-int
+int
IsWin95(void)
{
return (win32_os_id() == VER_PLATFORM_WIN32_WINDOWS);
char *ptr;
char *optr;
char *strip;
- int oldsize, newsize;
STRLEN baselen;
va_start(ap, trailing_path);
dTHX;
char regstr[40];
char pathstr[MAX_PATH+1];
- DWORD datalen;
- int len, newsize;
SV *sv1 = Nullsv;
SV *sv2 = Nullsv;
* for).
*/
const char* defaultshell = (IsWinNT()
- ? "cmd.exe /x/c" : "command.com /c");
+ ? "cmd.exe /x/d/c" : "command.com /c");
const char *usershell = PerlEnv_getenv("PERL5SHELL");
w32_perlshell_items = tokenize(usershell ? usershell : defaultshell,
&w32_perlshell_tokens,
}
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;
argv[index++] = "";
}
argv[index++] = 0;
-
+
status = win32_spawnvp(flag,
(const char*)(really ? SvPV_nolen(really) : argv[0]),
(const char* const*)argv);
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);
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
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;
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;
}
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;
}
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;
dirp->curr = NULL;
}
return &(dirp->dirstr);
- }
+ }
else
return NULL;
}
int
setuid(uid_t auid)
-{
+{
return (auid == ROOT_UID ? 0 : -1);
}
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;
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;
dTHX;
HANDLE hProcess;
long child;
+ int retval;
#ifdef USE_ITHREADS
if (pid < 0) {
/* it is a pseudo-forked child */
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);
+ switch (sig) {
+ case 0:
+ /* "Does process exist?" use of kill */
return 0;
- }
+ case 9:
+ /* kill -9 style un-graceful exit */
+ if (TerminateThread(hProcess, sig)) {
+ remove_dead_pseudo_process(child);
+ return 0;
+ }
+ break;
+ default:
+ /* 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;
+ }
+ break;
+ }
}
else if (IsWin95()) {
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);
+ hProcess = w32_child_handles[child];
+ switch(sig) {
+ case 0:
+ /* "Does process exist?" use of kill */
return 0;
- }
+ case 2:
+ if (GenerateConsoleCtrlEvent(CTRL_C_EVENT,pid))
+ return 0;
+ break;
+ case SIGBREAK:
+ case SIGTERM:
+ if (GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT,pid))
+ return 0;
+ break;
+ default: /* For now be backwards compatible with perl5.6 */
+ case 9:
+ if (TerminateProcess(hProcess, sig)) {
+ remove_dead_process(child);
+ return 0;
+ }
+ break;
+ }
}
else {
alien_process:
+ retval = -1;
hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE,
(IsWin95() ? -pid : pid));
if (hProcess) {
- if (!sig)
- return 0;
- if (TerminateProcess(hProcess, sig)) {
- CloseHandle(hProcess);
- return 0;
+ switch(sig) {
+ case 0:
+ /* "Does process exist?" use of kill */
+ retval = 0;
+ break;
+ case 2:
+ if (GenerateConsoleCtrlEvent(CTRL_C_EVENT,pid))
+ retval = 0;
+ break;
+ case SIGBREAK:
+ case SIGTERM:
+ if (GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT,pid))
+ retval = 0;
+ break;
+ default: /* For now be backwards compatible with perl5.6 */
+ case 9:
+ if (TerminateProcess(hProcess, sig))
+ retval = 0;
+ break;
}
}
+ CloseHandle(hProcess);
+ if (retval == 0)
+ return 0;
}
}
errno = EINVAL;
return -1;
}
-/*
- * File system stuff
- */
-
-DllExport unsigned int
-win32_sleep(unsigned int t)
-{
- Sleep(t*1000);
- return 0;
-}
-
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];
/* FindFirstFile() and stat() are buggy with a trailing
* backslash, so change it to a forward slash :-( */
case '\\':
+ if (l >= sizeof(buffer)) {
+ errno = ENAMETOOLONG;
+ return -1;
+ }
strncpy(buffer, path, l-1);
buffer[l - 1] = '/';
buffer[l] = '\0';
/* 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;
}
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))
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 *
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);
+ }
+
+ /* 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;
- /* discard doubled slashes */
- while (*start && (start[1] == '/' || start[1] == '\\'))
+ /* 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;
}
}
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 */
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)
{
/* 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:
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)
+{
+ MSG msg;
+ 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:
+ /* Treat WM_QUIT like SIGHUP? */
+ sig = SIGHUP;
+ goto Raise;
+ break;
+#endif
+
+ /* We use WM_USER to fake kill() with other signals */
+ case WM_USER: {
+ 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 && w32_timerid==msg.wParam) {
+ KillTimer(NULL,w32_timerid);
+ w32_timerid=0;
+ }
+ else
+ goto FallThrough;
+ /* Now fake a call to signal handler */
+ if (do_raise(aTHX_ 14)) {
+ sig_terminate(aTHX_ 14);
+ }
+ break;
+ }
+
+ /* Otherwise do normal Win32 thing - in case it is useful */
+ default:
+ FallThrough:
+ TranslateMessage(&msg);
+ DispatchMessage(&msg);
+ ours = 0;
+ break;
+ }
+ }
+ w32_poll_count = 0;
+
+ /* Above or other stuff may have set a signal flag */
+ if (PL_sig_pending) {
+ despatch_signals();
+ }
+ return ours;
+}
+
+/* This function will not return until the timeout has elapsed, or until
+ * one of the handles is ready. */
+DllExport DWORD
+win32_msgwait(pTHX_ DWORD count, LPHANDLE handles, DWORD timeout, LPDWORD resultp)
+{
+ /* We may need several goes at this - so compute when we stop */
+ DWORD ticks = 0;
+ if (timeout != INFINITE) {
+ ticks = GetTickCount();
+ timeout += ticks;
+ }
+ while (1) {
+ DWORD result = MsgWaitForMultipleObjects(count,handles,FALSE,timeout-ticks, QS_ALLEVENTS);
+ if (resultp)
+ *resultp = result;
+ if (result == WAIT_TIMEOUT) {
+ /* Ran out of time - explicit return of zero to avoid -ve if we
+ have scheduling issues
+ */
+ return 0;
+ }
+ if (timeout != INFINITE) {
+ ticks = GetTickCount();
+ }
+ if (result == WAIT_OBJECT_0 + count) {
+ /* Message has arrived - check it */
+ (void)win32_async_check(aTHX);
+ }
+ else {
+ /* Not timeout or message - one of handles is ready */
+ break;
+ }
+ }
+ /* compute time left to wait */
+ ticks = timeout - ticks;
+ /* If we are past the end say zero */
+ return (ticks > 0) ? ticks : 0;
+}
+
int
win32_internal_wait(int *status, DWORD timeout)
{
#ifdef USE_ITHREADS
if (w32_num_pseudo_children) {
- waitcode = WaitForMultipleObjects(w32_num_pseudo_children,
- w32_pseudo_child_handles,
- FALSE,
- timeout);
+ win32_msgwait(aTHX_ w32_num_pseudo_children, w32_pseudo_child_handles,
+ timeout, &waitcode);
/* Time out here if there are no other children to wait for. */
if (waitcode == WAIT_TIMEOUT) {
if (!w32_num_children) {
}
/* if a child exists, wait for it to die */
- waitcode = WaitForMultipleObjects(w32_num_children,
- w32_child_handles,
- FALSE,
- timeout);
+ win32_msgwait(aTHX_ w32_num_children, w32_child_handles, timeout, &waitcode);
if (waitcode == WAIT_TIMEOUT) {
return 0;
}
}
}
-FAILED:
errno = GetLastError();
return -1;
}
child = find_pseudo_pid(-pid);
if (child >= 0) {
HANDLE hThread = w32_pseudo_child_handles[child];
- DWORD waitcode = WaitForSingleObject(hThread, timeout);
+ DWORD waitcode;
+ win32_msgwait(aTHX_ 1, &hThread, timeout, &waitcode);
if (waitcode == WAIT_TIMEOUT) {
return 0;
}
- else if (waitcode != WAIT_FAILED) {
+ else if (waitcode == WAIT_OBJECT_0) {
if (GetExitCodeThread(hThread, &waitcode)) {
*status = (int)((waitcode & 0xff) << 8);
retval = (int)w32_pseudo_child_pids[child];
child = find_pid(pid);
if (child >= 0) {
hProcess = w32_child_handles[child];
- waitcode = WaitForSingleObject(hProcess, timeout);
+ win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
if (waitcode == WAIT_TIMEOUT) {
return 0;
}
- else if (waitcode != WAIT_FAILED) {
+ else if (waitcode == WAIT_OBJECT_0) {
if (GetExitCodeProcess(hProcess, &waitcode)) {
*status = (int)((waitcode & 0xff) << 8);
retval = (int)w32_child_pids[child];
hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE,
(IsWin95() ? -pid : pid));
if (hProcess) {
- waitcode = WaitForSingleObject(hProcess, timeout);
+ win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode);
if (waitcode == WAIT_TIMEOUT) {
+ CloseHandle(hProcess);
return 0;
}
- else if (waitcode != WAIT_FAILED) {
+ else if (waitcode == WAIT_OBJECT_0) {
if (GetExitCodeProcess(hProcess, &waitcode)) {
*status = (int)((waitcode & 0xff) << 8);
CloseHandle(hProcess);
errno = ECHILD;
}
}
- return retval >= 0 ? pid : retval;
+ return retval >= 0 ? pid : retval;
}
DllExport int
return win32_internal_wait(status, INFINITE);
}
-#ifndef PERL_IMPLICIT_CONTEXT
-
-static UINT timerid = 0;
-
-static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time)
+DllExport unsigned int
+win32_sleep(unsigned int t)
{
dTHX;
- KillTimer(NULL,timerid);
- timerid=0;
- CALL_FPTR(PL_sighandlerp)(14);
+ /* Win32 times are in ms so *1000 in and /1000 out */
+ return win32_msgwait(aTHX_ 0, NULL, t*1000, NULL)/1000;
}
-#endif /* !PERL_IMPLICIT_CONTEXT */
-
DllExport unsigned int
win32_alarm(unsigned int sec)
{
-#ifndef PERL_IMPLICIT_CONTEXT
- /*
+ /*
* 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 <signal.h>
- *
- * Snag is unless something is looking at the message queue
- * nothing happens :-(
- */
+ */
dTHX;
- if (sec)
- {
- timerid = SetTimer(NULL,timerid,sec*1000,(TIMERPROC)TimerProc);
- if (!timerid)
- Perl_croak_nocontext("Cannot set timer");
- }
- else
- {
- if (timerid)
- {
- KillTimer(NULL,timerid);
- timerid=0;
- }
- }
-#endif /* !PERL_IMPLICIT_CONTEXT */
+ if (sec) {
+ w32_timerid = SetTimer(NULL,w32_timerid,sec*1000,NULL);
+ }
+ else {
+ if (w32_timerid) {
+ KillTimer(NULL,w32_timerid);
+ w32_timerid=0;
+ }
+ }
return 0;
}
#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
* 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:
_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;
}
static int
-my_open_osfhandle(long osfhandle, int flags)
+my_open_osfhandle(intptr_t osfhandle, int flags)
{
int fh;
char fileflags; /* _osfile flags */
}
/*
- * 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;
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;
dTHX;
WCHAR wMode[MODE_SIZE], wBuffer[MAX_PATH+1];
FILE *f;
-
+
if (!*filename)
return NULL;
return fflush(pf);
}
-DllExport long
+DllExport Off_t
win32_ftell(FILE *pf)
{
+#if defined(WIN64) || defined(USE_LARGE_FILES)
+#if defined(__BORLAND__) /* buk */
+ return win32_tell( fileno( pf ) );
+#else
+ fpos_t pos;
+ if (fgetpos(pf, &pos))
+ return -1;
+ return (Off_t)pos;
+#endif
+#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)
+#if defined(__BORLANDC__) /* buk */
+ return win32_lseek(
+ fileno(pf),
+ offset,
+ origin
+ );
+#else
+ 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);
+#endif
+#else
return fseek(pf, offset, origin);
+#endif
}
DllExport int
win32_fgetpos(FILE *pf,fpos_t *p)
{
+#if defined(__BORLANDC__) && defined(USE_LARGE_FILES) /* buk */
+ if( win32_tell(fileno(pf)) == -1L ) {
+ errno = EBADF;
+ return -1;
+ }
+ return 0;
+#else
return fgetpos(pf, p);
+#endif
}
DllExport int
win32_fsetpos(FILE *pf,const fpos_t *p)
{
+#if defined(__BORLANDC__) && defined(USE_LARGE_FILES) /* buk */
+ return win32_lseek(fileno(pf), *p, SEEK_CUR);
+#else
return fsetpos(pf, p);
+#endif
}
DllExport void
return;
}
-DllExport FILE*
-win32_tmpfile(void)
+DllExport int
+win32_tmpfd(void)
{
dTHX;
char prefix[MAX_PATH+1];
| 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");
+ return fd;
}
}
}
}
+ return -1;
+}
+
+DllExport FILE*
+win32_tmpfile(void)
+{
+ int fd = win32_tmpfd();
+ if (fd >= 0)
+ return win32_fdopen(fd, "w+b");
return NULL;
}
}
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)) {
#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;
/* 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 */
if ((oldfd = win32_dup(stdfd)) == -1)
goto cleanup;
+ /* save the old std handle (this needs to happen before the
+ * dup2(), since that might call SetStdHandle() too) */
+ OP_REFCNT_LOCK;
+ lock_held = 1;
+ old_h = GetStdHandle(nhandle);
+
/* make stdfd go to child end of pipe (implicitly closes stdfd) */
/* stdfd will be inherited by the child */
if (win32_dup2(p[child], stdfd) == -1)
/* close the child end in parent */
win32_close(p[child]);
+ /* set the new std handle (in case dup2() above didn't) */
+ SetStdHandle(nhandle, (HANDLE)_get_osfhandle(stdfd));
+
/* start the child */
{
dTHX;
if (win32_dup2(oldfd, stdfd) == -1)
goto cleanup;
+ /* restore the old std handle (this needs to happen after the
+ * dup2(), since that might call SetStdHandle() too */
+ if (lock_held) {
+ SetStdHandle(nhandle, old_h);
+ OP_REFCNT_UNLOCK;
+ lock_held = 0;
+ }
+
/* close saved handle */
win32_close(oldfd);
/* 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);
return setmode(fd, mode);
}
-DllExport long
-win32_lseek(int fd, long offset, int origin)
+DllExport int
+win32_chsize(int fd, Off_t size)
{
+#if defined(WIN64) || defined(USE_LARGE_FILES)
+ int retval = 0;
+ Off_t cur, end, extend;
+
+ cur = win32_tell(fd);
+ if (cur < 0)
+ return -1;
+ end = win32_lseek(fd, 0, SEEK_END);
+ if (end < 0)
+ return -1;
+ extend = size - end;
+ if (extend == 0) {
+ /* do nothing */
+ }
+ else if (extend > 0) {
+ /* must grow the file, padding with nulls */
+ char b[4096];
+ int oldmode = win32_setmode(fd, O_BINARY);
+ size_t count;
+ memset(b, '\0', sizeof(b));
+ do {
+ count = extend >= sizeof(b) ? sizeof(b) : (size_t)extend;
+ count = win32_write(fd, b, count);
+ if ((int)count < 0) {
+ retval = -1;
+ break;
+ }
+ } while ((extend -= count) > 0);
+ win32_setmode(fd, oldmode);
+ }
+ else {
+ /* shrink the file */
+ win32_lseek(fd, size, SEEK_SET);
+ if (!SetEndOfFile((HANDLE)_get_osfhandle(fd))) {
+ errno = EACCES;
+ retval = -1;
+ }
+ }
+finish:
+ win32_lseek(fd, cur, SEEK_SET);
+ return retval;
+#else
+ return chsize(fd, size);
+#endif
+}
+
+DllExport Off_t
+win32_lseek(int fd, Off_t offset, int origin)
+{
+#if defined(WIN64) || defined(USE_LARGE_FILES)
+#if defined(__BORLANDC__) /* buk */
+ LARGE_INTEGER pos;
+ pos.QuadPart = offset;
+ pos.LowPart = SetFilePointer(
+ (HANDLE)_get_osfhandle(fd),
+ pos.LowPart,
+ &pos.HighPart,
+ origin
+ );
+ if (pos.LowPart == INVALID_SET_FILE_POINTER && GetLastError() != NO_ERROR) {
+ pos.QuadPart = -1;
+ }
+
+ return pos.QuadPart;
+#else
+ return _lseeki64(fd, offset, origin);
+#endif
+#else
return lseek(fd, offset, origin);
+#endif
}
-DllExport long
+DllExport Off_t
win32_tell(int fd)
{
+#if defined(WIN64) || defined(USE_LARGE_FILES)
+#if defined(__BORLANDC__) /* buk */
+ LARGE_INTEGER pos;
+ pos.QuadPart = 0;
+ pos.LowPart = SetFilePointer(
+ (HANDLE)_get_osfhandle(fd),
+ pos.LowPart,
+ &pos.HighPart,
+ FILE_CURRENT
+ );
+ if (pos.LowPart == INVALID_SET_FILE_POINTER && GetLastError() != NO_ERROR) {
+ pos.QuadPart = -1;
+ }
+
+ return pos.QuadPart;
+ /* return tell(fd); */
+#else
+ return _telli64(fd);
+#endif
+#else
return tell(fd);
+#endif
}
DllExport int
bytes_read = q - (char *)buf;
}
-functionexit:
+functionexit:
if (_pioinfo(fh)->lockinitflag)
LeaveCriticalSection(&(_pioinfo(fh)->lock)); /* unlock file */
|| (IsWinNT() && stricmp(&cname[clen-4], ".cmd") == 0)))
{
bat_file = TRUE;
- len += 3;
+ if (!IsWin95())
+ len += 3;
}
else {
char *exe = strrchr(cname, '/');
New(1310, cmd, len, char);
ptr = cmd;
- if (bat_file) {
+ if (bat_file && !IsWin95()) {
*ptr++ = '"';
extra_quotes = TRUE;
}
if (!extra_quotes
&& cmd_shell
- && (stricmp(arg, "/x/c") == 0 || stricmp(arg, "/c") == 0))
+ && curlen >= 2
+ && *arg == '/' /* see if arg is "/c", "/x/c", "/x/d/c" etc. */
+ && stricmp(arg+curlen-2, "/c") == 0)
{
/* is there a next argument? */
if (args[index+1]) {
/* look in PATH */
pathstr = PerlEnv_getenv("PATH");
- New(0, fullcmd, MAX_PATH+1, char);
+
+ /* worst case: PATH is a single directory; we need additional space
+ * to append "/", ".exe" and trailing "\0" */
+ New(0, fullcmd, (pathstr ? strlen(pathstr) : 0) + cmdlen + 6, char);
curfullcmd = fullcmd;
while (1) {
if (*pathstr == '"') { /* foo;"baz;etc";bar */
pathstr++; /* skip initial '"' */
while (*pathstr && *pathstr != '"') {
- if (curfullcmd-fullcmd < MAX_PATH-cmdlen-5)
- *curfullcmd++ = *pathstr;
- pathstr++;
+ *curfullcmd++ = *pathstr++;
}
if (*pathstr)
pathstr++; /* skip trailing '"' */
}
else {
- if (curfullcmd-fullcmd < MAX_PATH-cmdlen-5)
- *curfullcmd++ = *pathstr;
- pathstr++;
+ *curfullcmd++ = *pathstr++;
}
}
if (*pathstr)
*curfullcmd++ = '\\';
}
}
-GIVE_UP:
+
Safefree(fullcmd);
return Nullch;
}
* 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.
*/
ret = -1;
goto RETVAL;
}
+ /* Create a new process group so we can use GenerateConsoleCtrlEvent()
+ * in win32_kill()
+ */
+ create |= CREATE_NEW_PROCESS_GROUP;
/* FALL THROUGH */
+
case P_WAIT: /* synchronous execution */
break;
default: /* invalid mode */
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",
}
else {
DWORD status;
- WaitForSingleObject(ProcessInformation.hProcess, INFINITE);
+ win32_msgwait(aTHX_ 1, &ProcessInformation.hProcess, INFINITE, NULL);
+ /* FIXME: if msgwait returned due to message perhaps forward the
+ "signal" to the process
+ */
GetExitCodeProcess(ProcessInformation.hProcess, &status);
ret = (int)status;
CloseHandle(ProcessInformation.hProcess);
/* if this is a pseudo-forked child, we just want to spawn
* the new program, and return */
if (w32_pseudo_id) {
- int status = win32_spawnvp(P_WAIT, cmdname, (char *const *)argv);
+ int status = win32_spawnvp(P_WAIT, cmdname, (const char *const *)argv);
if (status != -1) {
my_exit(status);
return 0;
static DWORD allocsize = 0; /* XXX threadead */
void *
-sbrk(int need)
+sbrk(ptrdiff_t need)
{
void *result;
if (!pagesize)
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)
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
}
-int
-win32_open_osfhandle(long handle, int flags)
+DllExport int
+win32_open_osfhandle(intptr_t handle, int flags)
{
#ifdef USE_FIXED_OSFHANDLE
if (IsWin95())
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*
*/
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();
/* NERR_Success *is* 0*/
if (0 == pfnNetWkstaGetInfo(NULL, 100, &pwi)) {
if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
- WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_langroup,
+ WideCharToMultiByte(CP_ACP, 0, pwi->wki100_langroup,
-1, (LPSTR)dname, dnamelen, NULL, NULL);
}
else {
- WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_computername,
+ WideCharToMultiByte(CP_ACP, 0, pwi->wki100_computername,
-1, (LPSTR)dname, dnamelen, NULL, NULL);
}
pfnNetApiBufferFree(pwi);
XS(w32_GetOSVersion)
{
dXSARGS;
- OSVERSIONINFOA osver;
+ /* Use explicit struct definition because wSuiteMask and
+ * wProductType are not defined in the VC++ 6.0 headers.
+ * WORD type has been replaced by unsigned short because
+ * WORD is already used by Perl itself.
+ */
+ struct {
+ DWORD dwOSVersionInfoSize;
+ DWORD dwMajorVersion;
+ DWORD dwMinorVersion;
+ DWORD dwBuildNumber;
+ DWORD dwPlatformId;
+ CHAR szCSDVersion[128];
+ unsigned short wServicePackMajor;
+ unsigned short wServicePackMinor;
+ unsigned short wSuiteMask;
+ BYTE wProductType;
+ BYTE wReserved;
+ } osver;
+ BOOL bEx = TRUE;
if (USING_WIDE()) {
- OSVERSIONINFOW osverw;
+ struct {
+ DWORD dwOSVersionInfoSize;
+ DWORD dwMajorVersion;
+ DWORD dwMinorVersion;
+ DWORD dwBuildNumber;
+ DWORD dwPlatformId;
+ WCHAR szCSDVersion[128];
+ unsigned short wServicePackMajor;
+ unsigned short wServicePackMinor;
+ unsigned short wSuiteMask;
+ BYTE wProductType;
+ BYTE wReserved;
+ } osverw;
char szCSDVersion[sizeof(osverw.szCSDVersion)];
- osverw.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
- if (!GetVersionExW(&osverw)) {
- XSRETURN_EMPTY;
+ osverw.dwOSVersionInfoSize = sizeof(osverw);
+ if (!GetVersionExW((OSVERSIONINFOW*)&osverw)) {
+ bEx = FALSE;
+ osverw.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
+ if (!GetVersionExW((OSVERSIONINFOW*)&osverw)) {
+ XSRETURN_EMPTY;
+ }
+ }
+ if (GIMME_V == G_SCALAR) {
+ XSRETURN_IV(osverw.dwPlatformId);
}
W2AHELPER(osverw.szCSDVersion, szCSDVersion, sizeof(szCSDVersion));
XPUSHs(newSVpvn(szCSDVersion, strlen(szCSDVersion)));
- osver.dwMajorVersion = osverw.dwMajorVersion;
- osver.dwMinorVersion = osverw.dwMinorVersion;
- osver.dwBuildNumber = osverw.dwBuildNumber;
- osver.dwPlatformId = osverw.dwPlatformId;
+ osver.dwMajorVersion = osverw.dwMajorVersion;
+ osver.dwMinorVersion = osverw.dwMinorVersion;
+ osver.dwBuildNumber = osverw.dwBuildNumber;
+ osver.dwPlatformId = osverw.dwPlatformId;
+ osver.wServicePackMajor = osverw.wServicePackMajor;
+ osver.wServicePackMinor = osverw.wServicePackMinor;
+ osver.wSuiteMask = osverw.wSuiteMask;
+ osver.wProductType = osverw.wProductType;
}
else {
- osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
- if (!GetVersionExA(&osver)) {
- XSRETURN_EMPTY;
+ osver.dwOSVersionInfoSize = sizeof(osver);
+ if (!GetVersionExA((OSVERSIONINFOA*)&osver)) {
+ bEx = FALSE;
+ osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
+ if (!GetVersionExA((OSVERSIONINFOA*)&osver)) {
+ XSRETURN_EMPTY;
+ }
+ }
+ if (GIMME_V == G_SCALAR) {
+ XSRETURN_IV(osver.dwPlatformId);
}
XPUSHs(newSVpvn(osver.szCSDVersion, strlen(osver.szCSDVersion)));
}
XPUSHs(newSViv(osver.dwMinorVersion));
XPUSHs(newSViv(osver.dwBuildNumber));
XPUSHs(newSViv(osver.dwPlatformId));
+ if (bEx) {
+ XPUSHs(newSViv(osver.wServicePackMajor));
+ XPUSHs(newSViv(osver.wServicePackMinor));
+ XPUSHs(newSViv(osver.wSuiteMask));
+ XPUSHs(newSViv(osver.wProductType));
+ }
PUTBACK;
}
} while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1));
if (len) {
SvCUR_set(shortpath,len);
+ *SvEND(shortpath) = '\0';
ST(0) = shortpath;
XSRETURN(1);
}
SV *fullpath;
char *filepart;
DWORD len;
+ STRLEN filename_len;
+ char *filename_p;
if (items != 1)
Perl_croak(aTHX_ "usage: Win32::GetFullPathName($filename)");
filename = ST(0);
- fullpath = sv_mortalcopy(filename);
- SvUPGRADE(fullpath, SVt_PV);
+ filename_p = SvPV(filename, filename_len);
+ fullpath = sv_2mortal(newSVpvn(filename_p, filename_len));
if (!SvPVX(fullpath) || !SvLEN(fullpath))
XSRETURN_UNDEF;
if (len) {
if (GIMME_V == G_ARRAY) {
EXTEND(SP,1);
- XST_mPV(1,filepart);
- len = filepart - SvPVX(fullpath);
+ if (filepart) {
+ XST_mPV(1,filepart);
+ len = filepart - SvPVX(fullpath);
+ }
+ else {
+ XST_mPVN(1,"",0);
+ }
items = 2;
}
SvCUR_set(fullpath,len);
+ *SvEND(fullpath) = '\0';
ST(0) = fullpath;
XSRETURN(items);
}
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
*/
}
+void *
+win32_signal_context(void)
+{
+ dTHX;
+#ifdef MULTIPLICITY
+ if (!my_perl) {
+ my_perl = PL_curinterp;
+ PERL_SET_THX(my_perl);
+ }
+ return my_perl;
+#else
+ return PL_curinterp;
+#endif
+}
+
+
+BOOL WINAPI
+win32_ctrlhandler(DWORD dwCtrlType)
+{
+#ifdef MULTIPLICITY
+ dTHXa(PERL_GET_SIG_CONTEXT);
+
+ if (!my_perl)
+ return FALSE;
+#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
+ Task List
+ */
+ if (do_raise(aTHX_ 1)) /* SIGHUP */
+ sig_terminate(aTHX_ 1);
+ return TRUE;
+
+ case CTRL_C_EVENT:
+ /* A CTRL+c signal was received */
+ if (do_raise(aTHX_ SIGINT))
+ sig_terminate(aTHX_ SIGINT);
+ return TRUE;
+
+ case CTRL_BREAK_EVENT:
+ /* A CTRL+BREAK signal was received */
+ 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.
+ */
+ break;
+ case CTRL_SHUTDOWN_EVENT:
+ /* A signal that the system sends to all console processes when the system is
+ shutting down.
+ */
+ if (do_raise(aTHX_ SIGTERM))
+ sig_terminate(aTHX_ SIGTERM);
+ return TRUE;
+ default:
+ break;
+ }
+ return FALSE;
+}
+
+
void
Perl_win32_init(int *argcp, char ***argvp)
{
}
void
+Perl_win32_term(void)
+{
+ OP_REFCNT_TERM;
+ MALLOC_TERM;
+}
+
+void
win32_get_child_IO(child_IO_table* ptbl)
{
ptbl->childStdIn = GetStdHandle(STD_INPUT_HANDLE);
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
+
+static void
+win32_csighandler(int sig)
+{
+#if 0
+ dTHXa(PERL_GET_SIG_CONTEXT);
+ Perl_warn(aTHX_ "Got signal %d",sig);
+#endif
+ /* Does nothing */
+}
+
void
Perl_sys_intern_init(pTHX)
{
+ int i;
w32_perlshell_tokens = Nullch;
w32_perlshell_vec = (char**)NULL;
w32_perlshell_items = 0;
w32_num_pseudo_children = 0;
# endif
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) {
+# 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 */
+ SetConsoleCtrlHandler(win32_ctrlhandler,TRUE);
+ }
}
void
Safefree(w32_perlshell_vec);
/* NOTE: w32_fdpid is freed by sv_clean_all() */
Safefree(w32_children);
+ if (w32_timerid) {
+ KillTimer(NULL,w32_timerid);
+ w32_timerid=0;
+ }
+# ifdef MULTIPLICITY
+ if (my_perl == PL_curinterp) {
+# else
+ {
+# endif
+ SetConsoleCtrlHandler(win32_ctrlhandler,FALSE);
+ }
# ifdef USE_ITHREADS
Safefree(w32_pseudo_children);
# endif
dst->pseudo_id = 0;
Newz(1313, dst->pseudo_children, 1, child_tab);
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 */
}
GlobalFree((HGLOBAL)lpwStr);
}
-
https://perl5.git.perl.org / perl5.git / blobdiff