1#if __GLASGOW_HASKELL__ >= 709
2{-# LANGUAGE Safe #-}
3#elif __GLASGOW_HASKELL__ >= 701
4{-# LANGUAGE Trustworthy #-}
5#endif
6-----------------------------------------------------------------------------
7-- |
8-- Module      :  System.Win32.Process
9-- Copyright   :  (c) Alastair Reid, 1997-2003
10-- License     :  BSD-style (see the file libraries/base/LICENSE)
11--
12-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>
13-- Stability   :  provisional
14-- Portability :  portable
15--
16-- A collection of FFI declarations for interfacing with Win32.
17--
18-----------------------------------------------------------------------------
19
20module System.Win32.Process where
21import Control.Exception    ( bracket )
22import Control.Monad        ( liftM5 )
23import Foreign              ( Ptr, peekByteOff, allocaBytes, pokeByteOff
24                            , plusPtr )
25import Foreign.C.Types      ( CUInt(..) )
26import System.Win32.File    ( closeHandle )
27import System.Win32.Types
28
29##include "windows_cconv.h"
30
31#include <windows.h>
32#include <tlhelp32.h>
33
34-- constant to wait for a very long time.
35iNFINITE :: DWORD
36iNFINITE = #{const INFINITE}
37
38foreign import WINDOWS_CCONV unsafe "windows.h Sleep"
39  sleep :: DWORD -> IO ()
40
41
42type ProcessId = DWORD
43type ProcessHandle = HANDLE
44type ProcessAccessRights = DWORD
45#{enum ProcessAccessRights,
46    , pROCESS_ALL_ACCESS            = PROCESS_ALL_ACCESS
47    , pROCESS_CREATE_PROCESS        = PROCESS_CREATE_PROCESS
48    , pROCESS_CREATE_THREAD         = PROCESS_CREATE_THREAD
49    , pROCESS_DUP_HANDLE            = PROCESS_DUP_HANDLE
50    , pROCESS_QUERY_INFORMATION     = PROCESS_QUERY_INFORMATION
51    , pROCESS_SET_QUOTA             = PROCESS_SET_QUOTA
52    , pROCESS_SET_INFORMATION       = PROCESS_SET_INFORMATION
53    , pROCESS_TERMINATE             = PROCESS_TERMINATE
54    , pROCESS_VM_OPERATION          = PROCESS_VM_OPERATION
55    , pROCESS_VM_READ               = PROCESS_VM_READ
56    , pROCESS_VM_WRITE              = PROCESS_VM_WRITE
57    , sYNCHORNIZE                   = SYNCHRONIZE
58    }
59
60foreign import WINDOWS_CCONV unsafe "windows.h OpenProcess"
61    c_OpenProcess :: ProcessAccessRights -> BOOL -> ProcessId -> IO ProcessHandle
62
63
64openProcess :: ProcessAccessRights -> BOOL -> ProcessId -> IO ProcessHandle
65openProcess r inh i = failIfNull "OpenProcess" $ c_OpenProcess r inh i
66
67foreign import WINDOWS_CCONV unsafe "windows.h GetProcessId"
68    c_GetProcessId :: ProcessHandle -> IO ProcessId
69
70getProcessId :: ProcessHandle -> IO ProcessId
71getProcessId h = failIfZero "GetProcessId" $ c_GetProcessId h
72
73foreign import WINDOWS_CCONV unsafe "windows.h GetCurrentProcess"
74    c_GetCurrentProcess :: IO ProcessHandle
75
76foreign import WINDOWS_CCONV unsafe "windows.h GetCurrentProcessId"
77    c_GetCurrentProcessId :: IO ProcessId
78
79getCurrentProcessId :: IO ProcessId
80getCurrentProcessId = c_GetCurrentProcessId
81
82getCurrentProcess :: IO ProcessHandle
83getCurrentProcess = c_GetCurrentProcess
84
85foreign import WINDOWS_CCONV unsafe "windows.h TerminateProcess"
86    c_TerminateProcess :: ProcessHandle -> CUInt -> IO Bool
87
88terminateProcessById :: ProcessId -> IO ()
89terminateProcessById p = bracket
90    (openProcess pROCESS_TERMINATE False p)
91    closeHandle
92    (\h -> failIfFalse_ "TerminateProcess" $ c_TerminateProcess h 1)
93
94type Th32SnapHandle = HANDLE
95type Th32SnapFlags = DWORD
96-- | ProcessId, number of threads, parent ProcessId, process base priority, path of executable file
97type ProcessEntry32 = (ProcessId, Int, ProcessId, LONG, String)
98
99#{enum Th32SnapFlags,
100    , tH32CS_SNAPALL        = TH32CS_SNAPALL
101    , tH32CS_SNAPHEAPLIST   = TH32CS_SNAPHEAPLIST
102    , tH32CS_SNAPMODULE     = TH32CS_SNAPMODULE
103    , tH32CS_SNAPPROCESS    = TH32CS_SNAPPROCESS
104    , tH32CS_SNAPTHREAD     = TH32CS_SNAPTHREAD
105    }
106{-
107    , tH32CS_SNAPGETALLMODS = TH32CS_GETALLMODS
108    , tH32CS_SNAPNOHEAPS    = TH32CS_SNAPNOHEAPS
109-}
110
111foreign import WINDOWS_CCONV unsafe "tlhelp32.h CreateToolhelp32Snapshot"
112    c_CreateToolhelp32Snapshot :: Th32SnapFlags -> ProcessId -> IO Th32SnapHandle
113
114foreign import WINDOWS_CCONV unsafe "tlhelp32.h Process32FirstW"
115    c_Process32First :: Th32SnapHandle -> Ptr ProcessEntry32 -> IO BOOL
116
117foreign import WINDOWS_CCONV unsafe "tlhelp32.h Process32NextW"
118    c_Process32Next :: Th32SnapHandle -> Ptr ProcessEntry32 -> IO BOOL
119
120-- | Create a snapshot of specified resources.  Call closeHandle to close snapshot.
121createToolhelp32Snapshot :: Th32SnapFlags -> Maybe ProcessId -> IO Th32SnapHandle
122createToolhelp32Snapshot f p
123    = failIfNull "CreateToolhelp32Snapshot" $ c_CreateToolhelp32Snapshot
124        f (maybe 0 id p)
125
126withTh32Snap :: Th32SnapFlags -> Maybe ProcessId -> (Th32SnapHandle -> IO a) -> IO a
127withTh32Snap f p = bracket (createToolhelp32Snapshot f p) (closeHandle)
128
129
130peekProcessEntry32 :: Ptr ProcessEntry32 -> IO ProcessEntry32
131peekProcessEntry32 buf = liftM5 (,,,,)
132    ((#peek PROCESSENTRY32W, th32ProcessID) buf)
133    ((#peek PROCESSENTRY32W, cntThreads) buf)
134    ((#peek PROCESSENTRY32W, th32ParentProcessID) buf)
135    ((#peek PROCESSENTRY32W, pcPriClassBase) buf)
136    (peekTString $ (#ptr PROCESSENTRY32W, szExeFile) buf)
137
138-- | Enumerate processes using Process32First and Process32Next
139th32SnapEnumProcesses :: Th32SnapHandle -> IO [ProcessEntry32]
140th32SnapEnumProcesses h = allocaBytes (#size PROCESSENTRY32W) $ \pe -> do
141    (#poke PROCESSENTRY32W, dwSize) pe ((#size PROCESSENTRY32W)::DWORD)
142    ok <- c_Process32First h pe
143    readAndNext ok pe []
144    where
145        readAndNext ok pe res
146            | not ok    = do
147                err <- getLastError
148                if err == (#const ERROR_NO_MORE_FILES)
149                    then return $ reverse res
150                    else failWith "th32SnapEnumProcesses: Process32First/Process32Next" err
151            | otherwise = do
152                entry <- peekProcessEntry32 pe
153                ok' <- c_Process32Next h pe
154                readAndNext ok' pe (entry:res)
155