From: Jan Dubois Date: Wed, 20 Dec 2006 15:41:00 +0000 (-0800) Subject: Implement killpg() for MSWin32 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=542cb85fb9a8a115820bc461945b228d531b4059;p=p5sagit%2Fp5-mst-13.2.git Implement killpg() for MSWin32 Message-ID: p4raw-id: //depot/perl@29605 --- diff --git a/win32/config.bc b/win32/config.bc index f87e399..b769d48 100644 --- a/win32/config.bc +++ b/win32/config.bc @@ -266,7 +266,7 @@ d_isfinite='undef' d_isinf='undef' d_isnan='define' d_isnanl='undef' -d_killpg='undef' +d_killpg='define' d_lchown='undef' d_ldbl_dig='define' d_libm_lib_version='undef' diff --git a/win32/config.gc b/win32/config.gc index 72afe61..db6db85 100644 --- a/win32/config.gc +++ b/win32/config.gc @@ -266,7 +266,7 @@ d_isfinite='undef' d_isinf='undef' d_isnan='define' d_isnanl='undef' -d_killpg='undef' +d_killpg='define' d_lchown='undef' d_ldbl_dig='define' d_libm_lib_version='undef' diff --git a/win32/config.vc b/win32/config.vc index 5339125..bf0f223 100644 --- a/win32/config.vc +++ b/win32/config.vc @@ -266,7 +266,7 @@ d_isfinite='undef' d_isinf='undef' d_isnan='define' d_isnanl='undef' -d_killpg='undef' +d_killpg='define' d_lchown='undef' d_ldbl_dig='define' d_libm_lib_version='undef' diff --git a/win32/config.vc64 b/win32/config.vc64 index 0602555..b5d2962 100644 --- a/win32/config.vc64 +++ b/win32/config.vc64 @@ -266,7 +266,7 @@ d_isfinite='undef' d_isinf='undef' d_isnan='define' d_isnanl='undef' -d_killpg='undef' +d_killpg='define' d_lchown='undef' d_ldbl_dig='define' d_libm_lib_version='undef' diff --git a/win32/config_H.bc b/win32/config_H.bc index 3a75907..daee5ca 100644 --- a/win32/config_H.bc +++ b/win32/config_H.bc @@ -221,7 +221,7 @@ * to kill process groups. If unavailable, you probably should use kill * with a negative process number. */ -/*#define HAS_KILLPG /**/ +#define HAS_KILLPG /**/ /* HAS_LINK: * This symbol, if defined, indicates that the link routine is diff --git a/win32/config_H.gc b/win32/config_H.gc index 0fdff18..afea855 100644 --- a/win32/config_H.gc +++ b/win32/config_H.gc @@ -221,7 +221,7 @@ * to kill process groups. If unavailable, you probably should use kill * with a negative process number. */ -/*#define HAS_KILLPG /**/ +#define HAS_KILLPG /**/ /* HAS_LINK: * This symbol, if defined, indicates that the link routine is diff --git a/win32/config_H.vc b/win32/config_H.vc index c85f0aa..344fb7d 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -221,7 +221,7 @@ * to kill process groups. If unavailable, you probably should use kill * with a negative process number. */ -/*#define HAS_KILLPG /**/ +#define HAS_KILLPG /**/ /* HAS_LINK: * This symbol, if defined, indicates that the link routine is diff --git a/win32/config_H.vc64 b/win32/config_H.vc64 index b5d708c..f9708ae 100644 --- a/win32/config_H.vc64 +++ b/win32/config_H.vc64 @@ -221,7 +221,7 @@ * to kill process groups. If unavailable, you probably should use kill * with a negative process number. */ -/*#define HAS_KILLPG /**/ +#define HAS_KILLPG /**/ /* HAS_LINK: * This symbol, if defined, indicates that the link routine is diff --git a/win32/perlhost.h b/win32/perlhost.h index d6e1e0f..3860507 100644 --- a/win32/perlhost.h +++ b/win32/perlhost.h @@ -1611,9 +1611,7 @@ PerlProcKill(struct IPerlProc* piPerl, int pid, int sig) int PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig) { - dTHX; - Perl_croak(aTHX_ "killpg not implemented!\n"); - return 0; + return win32_kill(pid, -sig); } int diff --git a/win32/win32.c b/win32/win32.c index 3d00bb8..948aa25 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -22,9 +22,34 @@ # define WC_NO_BEST_FIT_CHARS 0x00000400 #endif #include +#include #include #include +#define SystemProcessesAndThreadsInformation 5 + +/* Inline some definitions from the DDK */ +typedef struct { + USHORT Length; + USHORT MaximumLength; + PWSTR Buffer; +} UNICODE_STRING; + +typedef struct { + ULONG NextEntryDelta; + ULONG ThreadCount; + ULONG Reserved1[6]; + LARGE_INTEGER CreateTime; + LARGE_INTEGER UserTime; + LARGE_INTEGER KernelTime; + UNICODE_STRING ProcessName; + LONG BasePriority; + ULONG ProcessId; + ULONG InheritedFromProcessId; + /* Remainder of the structure depends on the Windows version, + * but we don't need those additional fields anyways... */ +} SYSTEM_PROCESSES; + /* #include "config.h" */ #if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO) @@ -124,6 +149,11 @@ END_EXTERN_C static OSVERSIONINFO g_osver = {0, 0, 0, 0, 0, ""}; +static HANDLE (WINAPI *pfnCreateToolhelp32Snapshot)(DWORD, DWORD) = NULL; +static BOOL (WINAPI *pfnProcess32First)(HANDLE, PROCESSENTRY32*) = NULL; +static BOOL (WINAPI *pfnProcess32Next)(HANDLE, PROCESSENTRY32*) = NULL; +static LONG (WINAPI *pfnZwQuerySystemInformation)(UINT, PVOID, ULONG, PULONG); + #ifdef __BORLANDC__ /* Silence STDERR grumblings from Borland's math library. */ DllExport int @@ -1107,13 +1137,148 @@ remove_dead_pseudo_process(long child) } #endif +static int +terminate_process(DWORD pid, HANDLE process_handle, int sig) +{ + switch(sig) { + case 0: + /* "Does process exist?" use of kill */ + return 1; + case 2: + if (GenerateConsoleCtrlEvent(CTRL_C_EVENT, pid)) + return 1; + break; + case SIGBREAK: + case SIGTERM: + if (GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT, pid)) + return 1; + break; + default: /* For now be backwards compatible with perl 5.6 */ + case 9: + /* Note that we will only be able to kill processes owned by the + * current process owner, even when we are running as an administrator. + * To kill processes of other owners we would need to set the + * 'SeDebugPrivilege' privilege before obtaining the process handle. + */ + if (TerminateProcess(process_handle, sig)) + return 1; + break; + } + return 0; +} + +/* Traverse process tree using ToolHelp functions */ +static int +kill_process_tree_toolhelp(DWORD pid, int sig) +{ + HANDLE process_handle; + HANDLE snapshot_handle; + int killed = 0; + + process_handle = OpenProcess(PROCESS_TERMINATE, FALSE, pid); + if (process_handle == INVALID_HANDLE_VALUE) + return 0; + + killed += terminate_process(pid, process_handle, sig); + + snapshot_handle = pfnCreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); + if (snapshot_handle != INVALID_HANDLE_VALUE) { + PROCESSENTRY32 entry; + + entry.dwSize = sizeof(entry); + if (pfnProcess32First(snapshot_handle, &entry)) { + do { + if (entry.th32ParentProcessID == pid) + killed += kill_process_tree_toolhelp(entry.th32ProcessID, sig); + entry.dwSize = sizeof(entry); + } + while (pfnProcess32Next(snapshot_handle, &entry)); + } + CloseHandle(snapshot_handle); + } + CloseHandle(process_handle); + return killed; +} + +/* Traverse process tree using undocumented system information structures. + * This is only necessary on Windows NT, which lacks the ToolHelp functions. + */ +static int +kill_process_tree_sysinfo(SYSTEM_PROCESSES *process_info, DWORD pid, int sig) +{ + HANDLE process_handle; + SYSTEM_PROCESSES *p = process_info; + int killed = 0; + + process_handle = OpenProcess(PROCESS_TERMINATE, FALSE, pid); + if (process_handle == INVALID_HANDLE_VALUE) + return 0; + + killed += terminate_process(pid, process_handle, sig); + + while (1) { + if (p->InheritedFromProcessId == (DWORD)pid) + killed += kill_process_tree_sysinfo(process_info, p->ProcessId, sig); + + if (p->NextEntryDelta == 0) + break; + + p = (SYSTEM_PROCESSES*)((char*)p + p->NextEntryDelta); + } + + CloseHandle(process_handle); + return killed; +} + +int +killpg(int pid, int sig) +{ + /* Use "documented" method whenever available */ + if (pfnCreateToolhelp32Snapshot && pfnProcess32First && pfnProcess32Next) { + return kill_process_tree_toolhelp((DWORD)pid, sig); + } + + /* Fall back to undocumented Windows internals on Windows NT */ + if (pfnZwQuerySystemInformation) { + dTHX; + char *buffer; + DWORD size = 0; + + pfnZwQuerySystemInformation(SystemProcessesAndThreadsInformation, NULL, 0, &size); + Newx(buffer, size, char); + + if (pfnZwQuerySystemInformation(SystemProcessesAndThreadsInformation, buffer, size, NULL) >= 0) { + int killed = kill_process_tree_sysinfo((SYSTEM_PROCESSES*)buffer, (DWORD)pid, sig); + Safefree(buffer); + return killed; + } + } + return 0; +} + +static int +my_kill(int pid, int sig) +{ + int retval = 0; + HANDLE process_handle; + + if (sig < 0) + return killpg(pid, -sig); + + process_handle = OpenProcess(PROCESS_TERMINATE, FALSE, pid); + if (process_handle != INVALID_HANDLE_VALUE) { + retval = terminate_process(pid, process_handle, sig); + CloseHandle(process_handle); + } + return retval; +} + DllExport int win32_kill(int pid, int sig) { dTHX; HANDLE hProcess; long child; - int retval; #ifdef USE_ITHREADS if (pid < 0) { /* it is a pseudo-forked child */ @@ -1168,58 +1333,19 @@ win32_kill(int pid, int sig) { child = find_pid(pid); if (child >= 0) { - 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; + if (my_kill(pid, sig)) { + DWORD exitcode = 0; + if (GetExitCodeProcess(w32_child_handles[child], &exitcode) && + exitcode != STILL_ACTIVE) + { + remove_dead_process(child); + } + return 0; } } else { alien_process: - retval = -1; - hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, - (IsWin95() ? -pid : pid)); - if (hProcess) { - 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) + if (my_kill((IsWin95() ? -pid : pid), sig)) return 0; } } @@ -4490,6 +4616,8 @@ win32_ctrlhandler(DWORD dwCtrlType) void Perl_win32_init(int *argcp, char ***argvp) { + HMODULE module; + #if _MSC_VER >= 1400 _invalid_parameter_handler oldHandler, newHandler; newHandler = my_invalid_parameter_handler; @@ -4506,6 +4634,18 @@ Perl_win32_init(int *argcp, char ***argvp) _control87(MCW_EM, MCW_EM); #endif MALLOC_INIT; + + module = GetModuleHandle("ntdll.dll"); + if (module) { + *(FARPROC*)&pfnZwQuerySystemInformation = GetProcAddress(module, "ZwQuerySystemInformation"); + } + + module = GetModuleHandle("kernel32.dll"); + if (module) { + *(FARPROC*)&pfnCreateToolhelp32Snapshot = GetProcAddress(module, "CreateToolhelp32Snapshot"); + *(FARPROC*)&pfnProcess32First = GetProcAddress(module, "Process32First"); + *(FARPROC*)&pfnProcess32Next = GetProcAddress(module, "Process32Next"); + } } void diff --git a/win32/win32.h b/win32/win32.h index 2a87528..b065a35 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -282,6 +282,7 @@ extern gid_t getegid(void); extern int setuid(uid_t uid); extern int setgid(gid_t gid); extern int kill(int pid, int sig); +extern int killpg(int pid, int sig); #ifndef USE_PERL_SBRK extern void *sbrk(ptrdiff_t need); # define HAS_SBRK_PROTO