X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2Fwin32.c;h=40b7511296a5bef60414df500c4a362a88f6c868;hb=879fa96f55d904836d80046db7f8557649d93011;hp=19bb1dc2e5f0a9c550f5549d0d9a2d82c5e18328;hpb=4ae938798de4ad4b1af0d04709bcb628c08ec62d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/win32/win32.c b/win32/win32.c index 19bb1dc..40b7511 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -7,7 +7,7 @@ * 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 @@ -22,10 +22,10 @@ #endif #include #include +#include /* #include "config.h" */ -#define PERLIO_NOT_STDIO 0 #if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO) #define PerlIO FILE #endif @@ -586,6 +586,30 @@ do_aspawn(void *vreally, void **vmark, void **vsp) return (status); } +/* returns pointer to the next unquoted space or the end of the string */ +static char* +find_next_space(const char *s) +{ + bool in_quotes = FALSE; + while (*s) { + /* ignore doubled backslashes, or backslash+quote */ + if (*s == '\\' && (s[1] == '\\' || s[1] == '"')) { + s += 2; + } + /* keep track of when we're within quotes */ + else if (*s == '"') { + s++; + in_quotes = !in_quotes; + } + /* break it up only at spaces that aren't in quotes */ + else if (!in_quotes && isSPACE(*s)) + return (char*)s; + else + s++; + } + return (char*)s; +} + int do_spawn2(char *cmd, int exectype) { @@ -609,8 +633,7 @@ do_spawn2(char *cmd, int exectype) s++; if (*s) *(a++) = s; - while (*s && !isSPACE(*s)) - s++; + s = find_next_space(s); if (*s) *s++ = '\0'; } @@ -1058,13 +1081,27 @@ win32_kill(int pid, int sig) /* 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 */ + if (PostThreadMessage(-pid,WM_USER,sig,0)) { + /* It might be us ... */ + PERL_ASYNC_CHECK(); + return 0; + } + break; + } } else if (IsWin95()) { pid = -pid; @@ -1076,24 +1113,43 @@ win32_kill(int pid, int sig) { child = find_pid(pid); if (child >= 0) { - if (!sig) + hProcess = w32_child_handles[child]; + switch(sig) { + case 0: + /* "Does process exist?" use of kill */ return 0; - hProcess = w32_child_handles[child]; - if (TerminateProcess(hProcess, sig)) { - remove_dead_process(child); - return 0; - } + case 2: + if (GenerateConsoleCtrlEvent(CTRL_C_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: hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, (IsWin95() ? -pid : pid)); if (hProcess) { - if (!sig) - return 0; - if (TerminateProcess(hProcess, sig)) { - CloseHandle(hProcess); + switch(sig) { + case 0: + /* "Does process exist?" use of kill */ return 0; + case 2: + if (GenerateConsoleCtrlEvent(CTRL_C_EVENT,pid)) + return 0; + break; + default: /* For now be backwards compatible with perl5.6 */ + case 9: + if (TerminateProcess(hProcess, sig)) { + CloseHandle(hProcess); + return 0; + } } } } @@ -1102,17 +1158,6 @@ alien_process: 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) { @@ -1667,6 +1712,167 @@ win32_uname(struct utsname *name) return 0; } +/* Timing related stuff */ + +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)) { + switch(msg.message) { + +#if 0 + /* Perhaps some other messages could map to signals ? ... */ + case WM_CLOSE: + case WM_QUIT: + /* Treat WM_QUIT like SIGHUP? */ + CALL_FPTR(PL_sighandlerp)(1); + break; +#endif + + /* We use WM_USER to fake kill() with other signals */ + case WM_USER: { + CALL_FPTR(PL_sighandlerp)(msg.wParam); + 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; + } + /* Now fake a call to signal handler */ + CALL_FPTR(PL_sighandlerp)(14); + break; + } + + /* Otherwise do normal Win32 thing - in case it is useful */ + default: + 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; +} + +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 */ + if (win32_async_check(aTHX)) { + /* was one of ours */ + break; + } + } + 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) +{ + /* XXX this wait emulation only knows about processes + * spawned via win32_spawnvp(P_NOWAIT, ...). + */ + dTHX; + int i, retval; + DWORD exitcode, waitcode; + +#ifdef USE_ITHREADS + if (w32_num_pseudo_children) { + 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) { + return 0; + } + } + else if (waitcode != WAIT_FAILED) { + if (waitcode >= WAIT_ABANDONED_0 + && waitcode < WAIT_ABANDONED_0 + w32_num_pseudo_children) + i = waitcode - WAIT_ABANDONED_0; + else + i = waitcode - WAIT_OBJECT_0; + if (GetExitCodeThread(w32_pseudo_child_handles[i], &exitcode)) { + *status = (int)((exitcode & 0xff) << 8); + retval = (int)w32_pseudo_child_pids[i]; + remove_dead_pseudo_process(i); + return -retval; + } + } + } +#endif + + if (!w32_num_children) { + errno = ECHILD; + return -1; + } + + /* if a child exists, wait for it to die */ + win32_msgwait(aTHX_ w32_num_children, w32_child_handles, timeout, &waitcode); + if (waitcode == WAIT_TIMEOUT) { + return 0; + } + if (waitcode != WAIT_FAILED) { + if (waitcode >= WAIT_ABANDONED_0 + && waitcode < WAIT_ABANDONED_0 + w32_num_children) + i = waitcode - WAIT_ABANDONED_0; + else + i = waitcode - WAIT_OBJECT_0; + if (GetExitCodeProcess(w32_child_handles[i], &exitcode) ) { + *status = (int)((exitcode & 0xff) << 8); + retval = (int)w32_child_pids[i]; + remove_dead_process(i); + return retval; + } + } + +FAILED: + errno = GetLastError(); + return -1; +} + DllExport int win32_waitpid(int pid, int *status, int flags) { @@ -1675,17 +1881,18 @@ win32_waitpid(int pid, int *status, int flags) int retval = -1; long child; if (pid == -1) /* XXX threadid == 1 ? */ - return win32_wait(status); + return win32_internal_wait(status, timeout); #ifdef USE_ITHREADS else if (pid < 0) { 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]; @@ -1708,11 +1915,11 @@ win32_waitpid(int pid, int *status, int flags) 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]; @@ -1728,11 +1935,11 @@ alien_process: 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) { return 0; } - else if (waitcode != WAIT_FAILED) { + else if (waitcode == WAIT_OBJECT_0) { if (GetExitCodeProcess(hProcess, &waitcode)) { *status = (int)((waitcode & 0xff) << 8); CloseHandle(hProcess); @@ -1751,72 +1958,15 @@ alien_process: DllExport int win32_wait(int *status) { - /* XXX this wait emulation only knows about processes - * spawned via win32_spawnvp(P_NOWAIT, ...). - */ - dTHX; - int i, retval; - DWORD exitcode, waitcode; - -#ifdef USE_ITHREADS - if (w32_num_pseudo_children) { - waitcode = WaitForMultipleObjects(w32_num_pseudo_children, - w32_pseudo_child_handles, - FALSE, - INFINITE); - if (waitcode != WAIT_FAILED) { - if (waitcode >= WAIT_ABANDONED_0 - && waitcode < WAIT_ABANDONED_0 + w32_num_pseudo_children) - i = waitcode - WAIT_ABANDONED_0; - else - i = waitcode - WAIT_OBJECT_0; - if (GetExitCodeThread(w32_pseudo_child_handles[i], &exitcode)) { - *status = (int)((exitcode & 0xff) << 8); - retval = (int)w32_pseudo_child_pids[i]; - remove_dead_pseudo_process(i); - return -retval; - } - } - } -#endif - - if (!w32_num_children) { - errno = ECHILD; - return -1; - } - - /* if a child exists, wait for it to die */ - waitcode = WaitForMultipleObjects(w32_num_children, - w32_child_handles, - FALSE, - INFINITE); - if (waitcode != WAIT_FAILED) { - if (waitcode >= WAIT_ABANDONED_0 - && waitcode < WAIT_ABANDONED_0 + w32_num_children) - i = waitcode - WAIT_ABANDONED_0; - else - i = waitcode - WAIT_OBJECT_0; - if (GetExitCodeProcess(w32_child_handles[i], &exitcode) ) { - *status = (int)((exitcode & 0xff) << 8); - retval = (int)w32_child_pids[i]; - remove_dead_process(i); - return retval; - } - } - -FAILED: - errno = GetLastError(); - return -1; + return win32_internal_wait(status, INFINITE); } -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; } DllExport unsigned int @@ -1827,25 +1977,17 @@ win32_alarm(unsigned int sec) * which does whatever receiving SIGALRM would do * we cannot use SIGALRM even via raise() as it is not * one of the supported codes in - * - * 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; - } - } + if (sec) { + w32_timerid = SetTimer(NULL,w32_timerid,sec*1000,NULL); + } + else { + if (w32_timerid) { + KillTimer(NULL,w32_timerid); + w32_timerid=0; + } + } return 0; } @@ -2305,7 +2447,31 @@ win32_rewind(FILE *pf) DllExport FILE* win32_tmpfile(void) { - return tmpfile(); + dTHX; + char prefix[MAX_PATH+1]; + char filename[MAX_PATH+1]; + DWORD len = GetTempPath(MAX_PATH, prefix); + if (len && len < MAX_PATH) { + if (GetTempFileName(prefix, "plx", 0, filename)) { + HANDLE fh = CreateFile(filename, + DELETE | GENERIC_READ | GENERIC_WRITE, + 0, + NULL, + CREATE_ALWAYS, + FILE_ATTRIBUTE_NORMAL + | FILE_FLAG_DELETE_ON_CLOSE, + NULL); + if (fh != INVALID_HANDLE_VALUE) { + int fd = win32_open_osfhandle((long)fh, 0); + if (fd >= 0) { + DEBUG_p(PerlIO_printf(Perl_debug_log, + "Created tmpfile=%s\n",filename)); + return fdopen(fd, "w+b"); + } + } + } + } + return NULL; } DllExport void @@ -3047,26 +3213,155 @@ win32_chmod(const char *path, int mode) static char * -create_command_line(const char* command, const char * const *args) +create_command_line(char *cname, STRLEN clen, const char * const *args) { dTHX; - int index; - char *cmd, *ptr, *arg; - STRLEN len = strlen(command) + 1; + int index, argc; + char *cmd, *ptr; + const char *arg; + STRLEN len = 0; + bool bat_file = FALSE; + bool cmd_shell = FALSE; + bool dumb_shell = FALSE; + bool extra_quotes = FALSE; + bool quote_next = FALSE; + + if (!cname) + cname = (char*)args[0]; + + /* The NT cmd.exe shell has the following peculiarity that needs to be + * worked around. It strips a leading and trailing dquote when any + * of the following is true: + * 1. the /S switch was used + * 2. there are more than two dquotes + * 3. there is a special character from this set: &<>()@^| + * 4. no whitespace characters within the two dquotes + * 5. string between two dquotes isn't an executable file + * To work around this, we always add a leading and trailing dquote + * to the string, if the first argument is either "cmd.exe" or "cmd", + * and there were at least two or more arguments passed to cmd.exe + * (not including switches). + * XXX the above rules (from "cmd /?") don't seem to be applied + * always, making for the convolutions below :-( + */ + if (cname) { + if (!clen) + clen = strlen(cname); - for (index = 0; (ptr = (char*)args[index]) != NULL; ++index) - len += strlen(ptr) + 1; + if (clen > 4 + && (stricmp(&cname[clen-4], ".bat") == 0 + || (IsWinNT() && stricmp(&cname[clen-4], ".cmd") == 0))) + { + bat_file = TRUE; + len += 3; + } + else { + char *exe = strrchr(cname, '/'); + char *exe2 = strrchr(cname, '\\'); + if (exe2 > exe) + exe = exe2; + if (exe) + ++exe; + else + exe = cname; + if (stricmp(exe, "cmd.exe") == 0 || stricmp(exe, "cmd") == 0) { + cmd_shell = TRUE; + len += 3; + } + else if (stricmp(exe, "command.com") == 0 + || stricmp(exe, "command") == 0) + { + dumb_shell = TRUE; + } + } + } + DEBUG_p(PerlIO_printf(Perl_debug_log, "Args ")); + for (index = 0; (arg = (char*)args[index]) != NULL; ++index) { + STRLEN curlen = strlen(arg); + if (!(arg[0] == '"' && arg[curlen-1] == '"')) + len += 2; /* assume quoting needed (worst case) */ + len += curlen + 1; + DEBUG_p(PerlIO_printf(Perl_debug_log, "[%s]",arg)); + } + DEBUG_p(PerlIO_printf(Perl_debug_log, "\n")); + + argc = index; New(1310, cmd, len, char); ptr = cmd; - strcpy(ptr, command); + + if (bat_file) { + *ptr++ = '"'; + extra_quotes = TRUE; + } for (index = 0; (arg = (char*)args[index]) != NULL; ++index) { - ptr += strlen(ptr); - *ptr++ = ' '; + bool do_quote = 0; + STRLEN curlen = strlen(arg); + + /* we want to protect empty arguments and ones with spaces with + * dquotes, but only if they aren't already there */ + if (!dumb_shell) { + if (!curlen) { + do_quote = 1; + } + else if (quote_next) { + /* see if it really is multiple arguments pretending to + * be one and force a set of quotes around it */ + if (*find_next_space(arg)) + do_quote = 1; + } + else if (!(arg[0] == '"' && curlen > 1 && arg[curlen-1] == '"')) { + STRLEN i = 0; + while (i < curlen) { + if (isSPACE(arg[i])) { + do_quote = 1; + } + else if (arg[i] == '"') { + do_quote = 0; + break; + } + i++; + } + } + } + + if (do_quote) + *ptr++ = '"'; + strcpy(ptr, arg); + ptr += curlen; + + if (do_quote) + *ptr++ = '"'; + + if (args[index+1]) + *ptr++ = ' '; + + if (!extra_quotes + && cmd_shell + && (stricmp(arg, "/x/c") == 0 || stricmp(arg, "/c") == 0)) + { + /* is there a next argument? */ + if (args[index+1]) { + /* are there two or more next arguments? */ + if (args[index+2]) { + *ptr++ = '"'; + extra_quotes = TRUE; + } + else { + /* single argument, force quoting if it has spaces */ + quote_next = TRUE; + } + } + } } + if (extra_quotes) + *ptr++ = '"'; + + *ptr = '\0'; + return cmd; } @@ -3164,19 +3459,39 @@ GIVE_UP: * environment and the current directory to CreateProcess */ -void* -get_childenv(void) +DllExport void* +win32_get_childenv(void) { return NULL; } -void -free_childenv(void* d) +DllExport void +win32_free_childenv(void* d) { } -char* -get_childdir(void) +DllExport void +win32_clearenv(void) +{ + char *envv = GetEnvironmentStrings(); + char *cur = envv; + STRLEN len; + while (*cur) { + char *end = strchr(cur,'='); + if (end && end != cur) { + *end = '\0'; + SetEnvironmentVariable(cur, NULL); + *end = '='; + cur = end + strlen(end+1)+2; + } + else if ((len = strlen(cur))) + cur += len+1; + } + FreeEnvironmentStrings(envv); +} + +DllExport char* +win32_get_childdir(void) { dTHX; char* ptr; @@ -3195,8 +3510,8 @@ get_childdir(void) return ptr; } -void -free_childdir(char* d) +DllExport void +win32_free_childdir(char* d) { dTHX; Safefree(d); @@ -3228,10 +3543,30 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv) STARTUPINFO StartupInfo; PROCESS_INFORMATION ProcessInformation; DWORD create = 0; - - char *cmd = create_command_line(cmdname, strcmp(cmdname, argv[0]) == 0 - ? &argv[1] : argv); + char *cmd; char *fullcmd = Nullch; + char *cname = (char *)cmdname; + STRLEN clen = 0; + + if (cname) { + clen = strlen(cname); + /* if command name contains dquotes, must remove them */ + if (strchr(cname, '"')) { + cmd = cname; + New(0,cname,clen+1,char); + clen = 0; + while (*cmd) { + if (*cmd != '"') { + cname[clen] = *cmd; + ++clen; + } + ++cmd; + } + cname[clen] = '\0'; + } + } + + cmd = create_command_line(cname, clen, argv); env = PerlEnv_get_childenv(); dir = PerlEnv_get_childdir(); @@ -3243,7 +3578,12 @@ 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() + * in win32_kill() + */ + create |= CREATE_NEW_PROCESS_GROUP; /* FALL THROUGH */ + case P_WAIT: /* synchronous execution */ break; default: /* invalid mode */ @@ -3277,8 +3617,10 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv) create |= CREATE_NEW_CONSOLE; } + DEBUG_p(PerlIO_printf(Perl_debug_log, "Spawning [%s] with [%s]\n", + cname,cmd)); RETRY: - if (!CreateProcess(cmdname, /* search PATH to find executable */ + if (!CreateProcess(cname, /* search PATH to find executable */ cmd, /* executable, and its arguments */ NULL, /* process attributes */ NULL, /* thread attributes */ @@ -3296,9 +3638,14 @@ RETRY: * jump through our own hoops by picking out the path * we really want it to use. */ if (!fullcmd) { - fullcmd = qualified_path(cmdname); + fullcmd = qualified_path(cname); if (fullcmd) { - cmdname = fullcmd; + if (cname != cmdname) + Safefree(cname); + cname = fullcmd; + DEBUG_p(PerlIO_printf(Perl_debug_log, + "Retrying [%s] with same args\n", + cname)); goto RETRY; } } @@ -3319,7 +3666,10 @@ RETRY: } 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); @@ -3331,7 +3681,8 @@ RETVAL: PerlEnv_free_childenv(env); PerlEnv_free_childdir(dir); Safefree(cmd); - Safefree(fullcmd); + if (cname != cmdname) + Safefree(cname); return ret; #endif } @@ -3445,12 +3796,12 @@ win32_putchar(int c) #ifndef USE_PERL_SBRK -static char *committed = NULL; -static char *base = NULL; -static char *reserved = NULL; -static char *brk = NULL; -static DWORD pagesize = 0; -static DWORD allocsize = 0; +static char *committed = NULL; /* XXX threadead */ +static char *base = NULL; /* XXX threadead */ +static char *reserved = NULL; /* XXX threadead */ +static char *brk = NULL; /* XXX threadead */ +static DWORD pagesize = 0; /* XXX threadead */ +static DWORD allocsize = 0; /* XXX threadead */ void * sbrk(int need) @@ -4099,6 +4450,66 @@ Perl_init_os_extras(void) */ } +PerlInterpreter * +win32_signal_context(void) +{ + dTHX; + if (!my_perl) { + my_perl = PL_curinterp; + PERL_SET_THX(my_perl); + } + return my_perl; +} + +BOOL WINAPI +win32_ctrlhandler(DWORD dwCtrlType) +{ + dTHXa(PERL_GET_SIG_CONTEXT); + + if (!my_perl) + return FALSE; + + 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 + */ + CALL_FPTR(PL_sighandlerp)(1); /* SIGHUP */ + return TRUE; + + case CTRL_C_EVENT: + /* A CTRL+c signal was received */ + CALL_FPTR(PL_sighandlerp)(SIGINT); /* SIGINT */ + return TRUE; + + case CTRL_BREAK_EVENT: + /* A CTRL+BREAK signal was received */ + CALL_FPTR(PL_sighandlerp)(SIGBREAK); /* unix calls it SIGQUIT */ + 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. + */ + CALL_FPTR(PL_sighandlerp)(SIGTERM); + return TRUE; + break; + default: + break; + } + return FALSE; +} + + + void Perl_win32_init(int *argcp, char ***argvp) { @@ -4124,6 +4535,17 @@ win32_get_child_IO(child_IO_table* ptbl) #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) { @@ -4139,6 +4561,15 @@ Perl_sys_intern_init(pTHX) w32_num_pseudo_children = 0; # endif w32_init_socktype = 0; + w32_timerid = 0; + w32_poll_count = 0; + if (my_perl == PL_curinterp) { + /* 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 @@ -4148,6 +4579,13 @@ Perl_sys_intern_clear(pTHX) 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; + } + if (my_perl == PL_curinterp) { + SetConsoleCtrlHandler(win32_ctrlhandler,FALSE); + } # ifdef USE_ITHREADS Safefree(w32_pseudo_children); # endif @@ -4166,6 +4604,8 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst) 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; } # endif /* USE_ITHREADS */ #endif /* HAVE_INTERP_INTERN */ @@ -4199,3 +4639,6 @@ win32_argv2utf8(int argc, char** argv) GlobalFree((HGLOBAL)lpwStr); } + + +