From 9dbb34fefbf392293b841b153a00538577a7cd64 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 6 Mar 2021 16:52:58 -0600 Subject: [PATCH] windows: Add some win32 snapshot apis. --- basis/windows/errors/errors.factor | 11 ++ basis/windows/kernel32/kernel32.factor | 95 ++++++++++++++--- basis/windows/processes/authors.txt | 1 + basis/windows/processes/processes.factor | 125 +++++++++++++++++++++++ basis/windows/psapi/psapi.factor | 12 +++ 5 files changed, 231 insertions(+), 13 deletions(-) create mode 100644 basis/windows/processes/authors.txt create mode 100644 basis/windows/processes/processes.factor diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor index 8a057f9458..5edba766fc 100644 --- a/basis/windows/errors/errors.factor +++ b/basis/windows/errors/errors.factor @@ -686,6 +686,7 @@ CONSTANT: ERROR_INC_BACKUP 4003 CONSTANT: ERROR_FULL_BACKUP 4004 CONSTANT: ERROR_REC_NON_EXISTENT 4005 CONSTANT: ERROR_RPL_NOT_ALLOWED 4006 +CONSTANT: PEERDIST_ERROR_CONTENTINFO_VERSION_UNSUPPORTED 4050 CONSTANT: ERROR_NO_BROWSER_SERVERS_FOUND 6118 CONSTANT: SUBLANG_NEUTRAL 0 @@ -732,6 +733,16 @@ ERROR: windows-error n string ; : win32-error<0 ( n -- ) 0 < [ win32-error ] when ; : win32-error<>0 ( n -- ) zero? [ win32-error ] unless ; +: win32-allow-errors ( n allowed -- n ) + GetLastError 2dup swap member? [ + 2drop + ] [ + throw-windows-error + ] if ; + +: win32-error=0/f-allowed ( n allowed-seq -- n ) + over { 0 f } member? [ win32-allow-errors ] [ drop ] if ; + : check-invalid-handle ( handle -- handle ) dup INVALID_HANDLE_VALUE = [ win32-error ] when ; diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor index 2d6a200ea5..bf062d65f7 100644 --- a/basis/windows/kernel32/kernel32.factor +++ b/basis/windows/kernel32/kernel32.factor @@ -193,6 +193,7 @@ CONSTANT: PROCESS_CREATE_PROCESS 0x80 CONSTANT: PROCESS_SET_QUOTA 0x100 CONSTANT: PROCESS_SET_INFORMATION 0x200 CONSTANT: PROCESS_QUERY_INFORMATION 0x400 +CONSTANT: PROCESS_ALL_ACCESS 0x001F0FFF CONSTANT: MEM_COMMIT 0x1000 CONSTANT: MEM_RELEASE 0x8000 @@ -852,6 +853,31 @@ STRUCT: CONSOLE_SCREEN_BUFFER_INFO { srWindow SMALL_RECT } { dwMaximumWindowSize COORD } ; +CONSTANT: HEAP_CREATE_ENABLE_EXECUTE 0x00040000 +CONSTANT: HEAP_GENERATE_EXCEPTIONS 0x00000004 +CONSTANT: HEAP_NO_SERIALIZE 0x00000001 + +STRUCT: HEAPLIST32 + { dwSize SIZE_T } + { th32ProcessID DWORD } + { th32HeapID ULONG_PTR } + { dwFlags DWORD } ; +TYPEDEF: HEAPLIST32* PHEAPLIST32 +TYPEDEF: HEAPLIST32* LPHEAPLIST32 + +STRUCT: HEAPENTRY32 + { dwSize SIZE_T } + { hHandle HANDLE } + { dwAddress ULONG_PTR } + { dwBlockSize SIZE_T } + { dwFlags DWORD } + { dwLockCount DWORD } + { dwResvd DWORD } + { th32ProcessID DWORD } + { th32HeapID ULONG_PTR } ; +TYPEDEF: HEAPENTRY32* PHEAPENTRY32 +TYPEDEF: HEAPENTRY32* LPHEAPENTRY32 + STRUCT: PROCESSENTRY32 { dwSize DWORD } { cntUsage DWORD } @@ -863,10 +889,50 @@ STRUCT: PROCESSENTRY32 { pcPriClassBase LONG } { dwFlags DWORD } { szExeFile TCHAR[MAX_PATH] } ; - TYPEDEF: PROCESSENTRY32* PPROCESSENTRY32 TYPEDEF: PROCESSENTRY32* LPPROCESSENTRY32 +CONSTANT: MAX_MODULE_NAME32 255 +CONSTANT: MAX_MODULE_NAME32_SIZE 256 +! STRUCT: MODULEENTRY32 +! { dwSize DWORD } +! { th32ModuleID DWORD } +! { th32ProcessID DWORD } +! { GlblcntUsage DWORD } +! { ProccntUsage DWORD } +! { modBaseAddr BYTE* } +! { modBaseSize DWORD } +! { hModule HMODULE } +! { szModule char[MAX_MODULE_NAME32_SIZE] } +! { szExePath char[MAX_PATH] } ; +! TYPEDEF: MODULEENTRY32* PMODULEENTRY32 +! TYPEDEF: MODULEENTRY32* LPMODULEENTRY32 + +STRUCT: MODULEENTRY32W + { dwSize DWORD } + { th32ModuleID DWORD } + { th32ProcessID DWORD } + { GlblcntUsage DWORD } + { ProccntUsage DWORD } + { modBaseAddr BYTE* } + { modBaseSize DWORD } + { hModule HMODULE } + { szModule WCHAR[MAX_MODULE_NAME32_SIZE] } + { szExePath WCHAR[MAX_PATH] } ; +TYPEDEF: MODULEENTRY32W* PMODULEENTRY32W +TYPEDEF: MODULEENTRY32W* LPMODULEENTRY32W + +STRUCT: THREADENTRY32 + { dwSize DWORD } + { cntUsage DWORD } + { th32ThreadID DWORD } + { th32OwnerProcessID DWORD } + { tpBasePri LONG } + { tpDeltaPri LONG } + { dwFlags DWORD } ; +TYPEDEF: THREADENTRY32* PTHREADENTRY32 +TYPEDEF: THREADENTRY32* LPTHREADENTRY32 + ! Resource IDs : MAKEINTRESOURCE ( int -- resource ) 0xffff bitand ; inline @@ -1588,13 +1654,14 @@ FUNCTION: BOOL GlobalMemoryStatusEx ( LPMEMORYSTATUSEX lpBuffer ) FUNCTION: BOOL GlobalUnlock ( HGLOBAL hMem ) ! FUNCTION: GlobalUnWire ! FUNCTION: GlobalWire -! FUNCTION: Heap32First -! FUNCTION: Heap32ListFirst -! FUNCTION: Heap32ListNext -! FUNCTION: Heap32Next +FUNCTION: BOOL Heap32First ( LPHEAPENTRY32 lphe, DWORD th32ProcessID, ULONG_PTR th32HeapID ) +FUNCTION: BOOL Heap32ListFirst ( HANDLE hSnapshot, LPHEAPLIST32 lphl ) +FUNCTION: BOOL Heap32ListNext ( HANDLE hSnapshot, LPHEAPLIST32 lphl ) +FUNCTION: BOOL Heap32Next ( LPHEAPENTRY32 lphe ) FUNCTION: LPVOID HeapAlloc ( HANDLE hHeap, DWORD dwFlags, SIZE_T dwBytes ) ! FUNCTION: HeapCompact -! FUNCTION: HeapCreate + +FUNCTION: HANDLE HeapCreate ( DWORD flOptions, SIZE_T dwInitialSize, SIZE_T dwMaximumSize ) ! FUNCTION: HeapCreateTagsW ! FUNCTION: HeapDestroy ! FUNCTION: HeapExtend @@ -1709,10 +1776,10 @@ FUNCTION: LPVOID MapViewOfFileEx ( HANDLE hFileMappingObject, SIZE_T dwNumberOfBytesToMap, LPVOID lpBaseAddress ) -! FUNCTION: Module32First -! FUNCTION: Module32FirstW -! FUNCTION: Module32Next -! FUNCTION: Module32NextW +! FUNCTION: BOOL Module32First ( HANDLE hSnapshot, LPMODULEENTRY32 lpme ) +FUNCTION: BOOL Module32FirstW ( HANDLE hSnapshot, LPMODULEENTRY32W lpme ) +! FUNCTION: BOOL Module32Next ( HANDLE hSnapshot, LPMODULEENTRY32 lpme ) +FUNCTION: BOOL Module32NextW ( HANDLE hSnapshot, LPMODULEENTRY32W lpme ) ! FUNCTION: MoveFileA ! FUNCTION: MoveFileExA FUNCTION: BOOL MoveFileExW ( LPCSTR lpExistingFile, LPCSTR lpNewFileName, DWORD dwFlags ) @@ -1770,6 +1837,8 @@ ALIAS: Process32Next Process32NextW ! FUNCTION: QueryDepthSList ! FUNCTION: QueryDosDeviceA ! FUNCTION: QueryDosDeviceW +CONSTANT: PROCESS_NAME_NATIVE 1 +FUNCTION: BOOL QueryFullProcessImageNameA ( HANDLE hProcess, DWORD dwFlags, LPSTR lpExeName, PDWORD lpdwSize ) ! FUNCTION: QueryInformationJobObject ! FUNCTION: QueryMemoryResourceNotification FUNCTION: BOOL QueryPerformanceCounter ( LARGE_INTEGER* lpPerformanceCount ) @@ -1962,13 +2031,13 @@ FUNCTION: BOOL SystemTimeToFileTime ( SYSTEMTIME* lpSystemTime, LPFILETIME lpFil FUNCTION: BOOL TerminateProcess ( HANDLE hProcess, DWORD uExit ) ! FUNCTION: TerminateThread ! FUNCTION: TermsrvAppInstallMode -! FUNCTION: Thread32First -! FUNCTION: Thread32Next +FUNCTION: BOOL Thread32First ( HANDLE hSnapshot, LPTHREADENTRY32 lpte ) +FUNCTION: BOOL Thread32Next ( HANDLE hSnapshot, LPTHREADENTRY32 lpte ) ! FUNCTION: TlsAlloc ! FUNCTION: TlsFree ! FUNCTION: TlsGetValue ! FUNCTION: TlsSetValue -! FUNCTION: Toolhelp32ReadProcessMemory +FUNCTION: BOOL Toolhelp32ReadProcessMemory ( DWORD th32ProcessID, LPCVOID lpBaseAddress, LPVOID lpBuffer, SIZE_T cbRead, SIZE_T *lpNumberOfBytesRead ) ! FUNCTION: TransactNamedPipe ! FUNCTION: TransmitCommChar ! FUNCTION: TrimVirtualBuffer diff --git a/basis/windows/processes/authors.txt b/basis/windows/processes/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/windows/processes/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/windows/processes/processes.factor b/basis/windows/processes/processes.factor new file mode 100644 index 0000000000..b904003e1a --- /dev/null +++ b/basis/windows/processes/processes.factor @@ -0,0 +1,125 @@ +! Copyright (C) 2021 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien alien.c-types alien.data arrays +classes.struct destructors io.binary kernel literals sequences +strings windows windows.errors windows.handles windows.kernel32 +windows.types ; +IN: windows.processes + +: with-open-process ( access 1/0 processid quot -- ) + [ OpenProcess dup win32-error=0/f ] dip + '[ _ &dispose @ ] with-destructors ; inline + +: with-open-process-all-access ( processid quot -- ) + [ PROCESS_ALL_ACCESS FALSE ] 2dip with-open-process ; inline + +: with-create-toolhelp32-snapshot ( flags processId quot: ( alien -- alien ) -- ) + [ CreateToolhelp32Snapshot dup win32-error=0/f ] dip + '[ + _ [ &dispose drop ] keep @ + ] with-destructors ; inline + +: with-create-toolhelp32-snapshot-processes ( quot: ( alien -- processes ) -- ) + [ TH32CS_SNAPPROCESS 0 ] dip with-create-toolhelp32-snapshot ; inline + +: with-create-toolhelp32-snapshot-modules ( processId quot: ( alien -- processes ) -- ) + [ TH32CS_SNAPMODULE ] 2dip with-create-toolhelp32-snapshot ; inline + +: with-create-toolhelp32-snapshot-threads ( processId quot: ( alien -- processes ) -- ) + [ TH32CS_SNAPTHREAD ] 2dip with-create-toolhelp32-snapshot ; inline + +: with-create-toolhelp32-snapshot-heaplists ( quot: ( alien -- heaplists ) -- ) + [ TH32CS_SNAPHEAPLIST GetCurrentProcessId ] dip with-create-toolhelp32-snapshot ; inline + +: check-snapshot ( n -- continue? ) + ${ ERROR_NO_MORE_FILES } win32-error=0/f-allowed 1 = ; + +: get-process-list ( -- processes ) + [ + PROCESSENTRY32 [ dup byte-length >>dwSize Process32FirstW check-snapshot ] 2keep rot [ + [ + [ + PROCESSENTRY32 [ + dup byte-length >>dwSize Process32NextW + check-snapshot + ] 2keep rot + ] [ + ] produce + ] dip prefix 2nip + ] [ + 1array nip + ] if + ] with-create-toolhelp32-snapshot-processes ; + +: get-process-modules ( dwPid -- processes ) + [ + MODULEENTRY32W [ + dup byte-length >>dwSize Module32FirstW check-snapshot ] 2keep rot [ + [ + [ + MODULEENTRY32W [ + dup byte-length >>dwSize + Module32NextW check-snapshot + ] 2keep rot + ] [ + ] produce + ] dip prefix 2nip + ] [ + 1array nip + ] if + ] with-create-toolhelp32-snapshot-modules ; + +: get-process-threads ( dwPid -- processes ) + [ + THREADENTRY32 [ + dup byte-length >>dwSize Thread32First check-snapshot ] 2keep rot [ + [ + [ + THREADENTRY32 [ + dup byte-length >>dwSize + Thread32Next check-snapshot + ] 2keep rot + ] [ + ] produce + ] dip prefix 2nip + ] [ + 1array nip + ] if + ] with-create-toolhelp32-snapshot-threads ; + +: get-heap-entries ( heapId -- heap-entries ) + [ + HEAPENTRY32 dup byte-length >>dwSize GetCurrentProcessId + ] dip [ Heap32First check-snapshot ] 3keep 2drop dup clone rot + [ + [ + [ Heap32Next check-snapshot ] keep swap + ] [ dup clone ] produce swap prefix nip + ] [ + 1array nip + ] if ; + +: get-heap-lists ( -- heaplists ) + [ + HEAPLIST32 [ dup byte-length >>dwSize Heap32ListFirst check-snapshot ] 2keep rot [ + ! dup th32HeapID>> get-heap-entries describe + [ + [ + HEAPLIST32 + [ dup byte-length >>dwSize Heap32ListNext check-snapshot ] 2keep rot + ] [ + ] produce + ] dip prefix 2nip + ] [ + 2drop { } + ] if + ] with-create-toolhelp32-snapshot-heaplists ; + +: get-process-image-name ( processId -- string ) + 0 MAX_UNICODE_PATH + [ uchar ] [ DWORD ] bi + [ QueryFullProcessImageNameA win32-error=0/f ] 2keep + le> head >string ; + +: get-my-process-image-name ( -- string ) + GetCurrentProcess get-process-image-name ; \ No newline at end of file diff --git a/basis/windows/psapi/psapi.factor b/basis/windows/psapi/psapi.factor index a4d8ccff23..cc475cb15f 100644 --- a/basis/windows/psapi/psapi.factor +++ b/basis/windows/psapi/psapi.factor @@ -10,3 +10,15 @@ FUNCTION: BOOL EnumDeviceDrivers ( LPVOID* lpImageBase, DWORD cb, LPDWORD lpcbNe FUNCTION: DWORD GetDeviceDriverBaseNameW ( LPVOID ImageBase, LPTSTR lpBaseName, DWORD nSize ) ALIAS: GetDeviceDriverBaseName GetDeviceDriverBaseNameW + +FUNCTION: DWORD GetModuleFileNameExW ( HANDLE hProcess, + HMODULE hModule, + LPWSTR lpFilename, + DWORD nSize +) + +FUNCTION: DWORD GetProcessImageFileNameA ( + HANDLE hProcess, + LPSTR lpImageFileName, + DWORD nSize +) -- 2.34.1