packages feed

Win32-services 0.2 → 0.2.1

raw patch · 7 files changed

+88/−82 lines, 7 files

Files

Win32-services.cabal view
@@ -1,6 +1,6 @@ name:           Win32-services
 category:       System
-version:        0.2
+version:        0.2.1
 cabal-version:  >= 1.14
 build-type:     Simple
 author:         Michael Steele
@@ -15,7 +15,7 @@ synopsis:       Windows service applications
 description:
   This package provides a partial binding to the Win32 System Services
-  API. It's now possible to write Windows service applications using
+  API. It makes it easy to write Windows service applications using
   Haskell.
   .
   The binding is partial. Here are a few ways in which it differs from the
@@ -53,6 +53,7 @@       startServiceCtrlDispatcher \"Test\" 3000 (handler mStop) $ \\_ _ h -> do
           setServiceStatus h running
           takeMVar mStop
+          setServiceStatus h stopped
   .
   handler mStop hStatus STOP = do
       setServiceStatus hStatus stopPending
@@ -62,9 +63,8 @@   handler _ _ _           = return False
   .
   running = SERVICE_STATUS WIN32_OWN_PROCESS RUNNING [ACCEPT_STOP] nO_ERROR 0 0 0
-  stopPending = running { currentState = STOP_PENDING
-                        , controlsAccepted = []
-                        , waitHint = 3000 }
+  stopped = SERVICE_STATUS WIN32_OWN_PROCESS STOPPED [] nO_ERROR 0 0 0
+  stopPending = SERVICE_STATUS WIN32_OWN_PROCESS START_PENDING [ACCEPT_STOP] nO_ERROR 0 0 0
   @
   .
   @
@@ -99,6 +99,13 @@   @
   .
   Release Notes:
+  .
+  Changes in 0.2.1
+  .
+  * bug fix: Services were failing to enter a STOPPED state. It is now the
+    user's responsibility to enter a stopped state in the service main function.
+    The 'startServiceCtrlDispatcher' function will continue to automatically put
+    the service into a START_PENDING state.
   .
   Changes in 0.2
   .
examples/official.hs view
@@ -14,6 +14,7 @@ svcMain mStop gState _ _ h = do
     reportSvcStatus h RUNNING nO_ERROR 0 gState
     takeMVar mStop
+    reportSvcStatus h STOPPED nO_ERROR 0 gState
 
 reportSvcStatus :: HANDLE -> SERVICE_STATE -> DWORD -> DWORD
     -> MVar (DWORD, SERVICE_STATUS) -> IO ()
examples/simple.hs view
@@ -8,6 +8,7 @@     startServiceCtrlDispatcher "Test" 3000 (handler mStop) $ \_ _ h -> do
         setServiceStatus h running
         takeMVar mStop
+        setServiceStatus h stopped
 
 handler mStop hStatus STOP = do
     setServiceStatus hStatus stopPending
@@ -17,6 +18,5 @@ handler _ _ _           = return False
 
 running = SERVICE_STATUS WIN32_OWN_PROCESS RUNNING [ACCEPT_STOP] nO_ERROR 0 0 0
-stopPending = running { currentState = STOP_PENDING
-                      , controlsAccepted = []
-                      , waitHint = 3000 }
+stopped = SERVICE_STATUS WIN32_OWN_PROCESS STOPPED [] nO_ERROR 0 0 0
+stopPending = SERVICE_STATUS WIN32_OWN_PROCESS START_PENDING [ACCEPT_STOP] nO_ERROR 0 0 0
src/System/Win32/SystemServices/Services.hs view
@@ -149,8 +149,6 @@     (h, fpHandler) <- registerServiceCtrlHandlerEx name handler
     setServiceStatus h $ SERVICE_STATUS WIN32_OWN_PROCESS START_PENDING [] nO_ERROR 0 0 wh
     f name (tail args) h
-    status <- queryServiceStatus h
-    setServiceStatus h $ status {currentState = STOPPED, controlsAccepted = []}
     freeHaskellFunPtr fpHandler
 
 -- This was originally written with older style handle functions in mind.
src/System/Win32/SystemServices/Services/Raw.hs view
@@ -1,33 +1,33 @@-{-# LANGUAGE ForeignFunctionInterface #-}
-
-module System.Win32.SystemServices.Services.Raw where
-
-import Foreign.Ptr (Ptr)
-import System.Win32.Types
-
-import System.Win32.SystemServices.Services.SERVICE_STATUS
-import System.Win32.SystemServices.Services.SERVICE_TABLE_ENTRY
-import System.Win32.SystemServices.Services.Types
-
-foreign import stdcall "wrapper"
-    smfToFunPtr :: SERVICE_MAIN_FUNCTION -> IO LPSERVICE_MAIN_FUNCTION
-
-foreign import stdcall "wrapper"
-    handlerToFunPtr :: HANDLER_FUNCTION_EX -> IO LPHANDLER_FUNCTION_EX
-
--- BOOL WINAPI QueryServiceStatus(
---   _In_   SC_HANDLE hService,
---   _Out_  LPSERVICE_STATUS lpServiceStatus
--- );
-foreign import stdcall "windows.h QueryServiceStatus"
-    c_QueryServiceStatus :: HANDLE -> Ptr SERVICE_STATUS -> IO BOOL
-
--- I've not been able to get RegisterServiceCtrlHandler to work on Windows 7 64-bit.
-foreign import stdcall "windows.h RegisterServiceCtrlHandlerExW"
-    c_RegisterServiceCtrlHandlerEx :: LPTSTR -> LPHANDLER_FUNCTION_EX  -> Ptr () -> IO HANDLE
-
-foreign import stdcall "windows.h SetServiceStatus"
-    c_SetServiceStatus :: HANDLE -> Ptr SERVICE_STATUS -> IO BOOL
-
-foreign import stdcall "windows.h StartServiceCtrlDispatcherW"
-    c_StartServiceCtrlDispatcher :: Ptr SERVICE_TABLE_ENTRY -> IO BOOL
+{-# LANGUAGE ForeignFunctionInterface #-}++module System.Win32.SystemServices.Services.Raw where++import Foreign.Ptr (Ptr)+import System.Win32.Types++import System.Win32.SystemServices.Services.SERVICE_STATUS+import System.Win32.SystemServices.Services.SERVICE_TABLE_ENTRY+import System.Win32.SystemServices.Services.Types++foreign import stdcall "wrapper"+    smfToFunPtr :: SERVICE_MAIN_FUNCTION -> IO LPSERVICE_MAIN_FUNCTION++foreign import stdcall "wrapper"+    handlerToFunPtr :: HANDLER_FUNCTION_EX -> IO LPHANDLER_FUNCTION_EX++-- BOOL WINAPI QueryServiceStatus(+--   _In_   SC_HANDLE hService,+--   _Out_  LPSERVICE_STATUS lpServiceStatus+-- );+foreign import stdcall "windows.h QueryServiceStatus"+    c_QueryServiceStatus :: HANDLE -> Ptr SERVICE_STATUS -> IO BOOL++-- I've not been able to get RegisterServiceCtrlHandler to work on Windows 7 64-bit.+foreign import stdcall "windows.h RegisterServiceCtrlHandlerExW"+    c_RegisterServiceCtrlHandlerEx :: LPTSTR -> LPHANDLER_FUNCTION_EX  -> Ptr () -> IO HANDLE++foreign import stdcall "windows.h SetServiceStatus"+    c_SetServiceStatus :: HANDLE -> Ptr SERVICE_STATUS -> IO BOOL++foreign import stdcall "windows.h StartServiceCtrlDispatcherW"+    c_StartServiceCtrlDispatcher :: Ptr SERVICE_TABLE_ENTRY -> IO BOOL
src/System/Win32/SystemServices/Services/SERVICE_TABLE_ENTRY.hs view
@@ -1,29 +1,29 @@-module System.Win32.SystemServices.Services.SERVICE_TABLE_ENTRY where
-
-import Control.Applicative
-import Foreign
-import System.Win32.Types
-
-import System.Win32.SystemServices.Services.Types
-
-data SERVICE_TABLE_ENTRY = SERVICE_TABLE_ENTRY
-    { serviceName :: LPWSTR
-    , serviceProc :: FunPtr SERVICE_MAIN_FUNCTION
-    }
-
-instance Storable SERVICE_TABLE_ENTRY where
-  sizeOf _ = 8
-  alignment _ = 4
-  peek ptr = SERVICE_TABLE_ENTRY <$> peek pServiceName <*> peek pServiceProc
-    where
-      pServiceName = castPtr ptr
-      pServiceProc = castPtr ptr `plusPtr` 4
-  poke ptr ste = do
-      poke pServiceName . serviceName $ ste
-      poke pServiceProc . serviceProc $ ste
-    where
-      pServiceName = castPtr ptr
-      pServiceProc = castPtr ptr `plusPtr` 4
-
-nullSTE :: SERVICE_TABLE_ENTRY
-nullSTE = SERVICE_TABLE_ENTRY nullPtr nullFunPtr
+module System.Win32.SystemServices.Services.SERVICE_TABLE_ENTRY where++import Control.Applicative+import Foreign+import System.Win32.Types++import System.Win32.SystemServices.Services.Types++data SERVICE_TABLE_ENTRY = SERVICE_TABLE_ENTRY+    { serviceName :: LPWSTR+    , serviceProc :: FunPtr SERVICE_MAIN_FUNCTION+    }++instance Storable SERVICE_TABLE_ENTRY where+  sizeOf _ = 8+  alignment _ = 4+  peek ptr = SERVICE_TABLE_ENTRY <$> peek pServiceName <*> peek pServiceProc+    where+      pServiceName = castPtr ptr+      pServiceProc = castPtr ptr `plusPtr` 4+  poke ptr ste = do+      poke pServiceName . serviceName $ ste+      poke pServiceProc . serviceProc $ ste+    where+      pServiceName = castPtr ptr+      pServiceProc = castPtr ptr `plusPtr` 4++nullSTE :: SERVICE_TABLE_ENTRY+nullSTE = SERVICE_TABLE_ENTRY nullPtr nullFunPtr
src/System/Win32/SystemServices/Services/Types.hs view
@@ -1,10 +1,10 @@-module System.Win32.SystemServices.Services.Types where
-
-import Foreign.Ptr (FunPtr, Ptr)
-import System.Win32.Types
-
-type HANDLER_FUNCTION_EX = DWORD -> DWORD -> Ptr () -> Ptr () -> IO DWORD
-type LPHANDLER_FUNCTION_EX = FunPtr HANDLER_FUNCTION_EX
-
-type SERVICE_MAIN_FUNCTION = DWORD -> Ptr LPTSTR -> IO ()
-type LPSERVICE_MAIN_FUNCTION = FunPtr SERVICE_MAIN_FUNCTION
+module System.Win32.SystemServices.Services.Types where++import Foreign.Ptr (FunPtr, Ptr)+import System.Win32.Types++type HANDLER_FUNCTION_EX = DWORD -> DWORD -> Ptr () -> Ptr () -> IO DWORD+type LPHANDLER_FUNCTION_EX = FunPtr HANDLER_FUNCTION_EX++type SERVICE_MAIN_FUNCTION = DWORD -> Ptr LPTSTR -> IO ()+type LPSERVICE_MAIN_FUNCTION = FunPtr SERVICE_MAIN_FUNCTION