Win32-services-wrapper (empty) → 0.1.0.0

raw patch · 4 files changed

+159/−0 lines, 4 filesdep +Win32dep +Win32-servicesdep +basesetup-changed

Dependencies added: Win32, Win32-services, base, directory, filepath

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• Win32-services-wrapper.cabal +43/−0
• src/System/Win32/SystemServices/Wrapper.hs +84/−0

@@ -0,0 +1,30 @@+Copyright (c) 2013, Ganesh Sittampalam <ganesh@earth.li>
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Ganesh Sittampalam <ganesh@earth.li> nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain

@@ -0,0 +1,43 @@+-- Initial Win32-services-utils.cabal generated by cabal init.  For further+--  documentation, see http://haskell.org/cabal/users-guide/++name:                Win32-services-wrapper+version:             0.1.0.0+synopsis:            Wrapper code for making a Win32 service+description:         Builds on the Win32-services package, providing a simple+                     wrapper for turning a long-running process into a+                     Windows service.+license:             BSD3+license-file:        LICENSE+author:              Ganesh Sittampalam <ganesh@earth.li>+maintainer:          Ganesh Sittampalam <ganesh@earth.li>+-- copyright:           +category:            System+build-type:          Simple+cabal-version:       >=1.8++source-repository head+  type:     darcs+  location: http://hub.darcs.net/ganesh/Win32-services-wrapper++flag warn-as-error+  default:     False+  description: Build with warnings-as-errors++library+  build-tools:         ghc >= 7.4 && < 7.8+  hs-source-dirs:      src+  exposed-modules:     System.Win32.SystemServices.Wrapper+  other-modules:+  build-depends:       +                       Win32-services ==0.2.*,+                       Win32 >= 2.2 && < 2.4,+                       filepath ==1.3.*,+                       directory >= 1.1 && < 1.3,+                       base >= 4.5 && < 4.7++  if flag(warn-as-error)+    ghc-options:      -Werror++  if true+    ghc-options:      -Wall

@@ -0,0 +1,84 @@+{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables+ #-}+module System.Win32.SystemServices.Wrapper+    ( Service(..)+    , defineService+    ) where++import Prelude hiding ( catch )++import Control.Concurrent ( MVar, newEmptyMVar, putMVar, takeMVar )+import Control.Exception ( catch, throwIO, SomeException )+import System.Directory ( getTemporaryDirectory )+import System.FilePath ( (</>) )+import System.IO+    ( hSetBuffering, BufferMode(NoBuffering)+    , openFile, IOMode(WriteMode)+    , Handle, hPutStrLn+    )+import System.Win32.SystemServices.Services+    ( SERVICE_STATUS(..), SERVICE_STATE(..)+    , SERVICE_CONTROL(..), SERVICE_ACCEPT(..), SERVICE_TYPE(..)+    , setServiceStatus, startServiceCtrlDispatcher+    , nO_ERROR+    )+import System.Win32.Types ( HANDLE, DWORD )++data Service serviceState =+    Service {+          serviceName :: String+        , serviceStart :: Handle -> IO serviceState+        , serviceStop :: serviceState -> IO ()+    }++handler :: MVar () -> HANDLE -> SERVICE_CONTROL -> IO Bool+handler stopSignal hStatus STOP = do+    setServiceStatus hStatus stopPending+    putMVar stopSignal ()+    return True+handler _ _ INTERROGATE = return True+handler _ _ _           = return False++running, stopPending, stopped :: SERVICE_STATUS+running = SERVICE_STATUS WIN32_OWN_PROCESS RUNNING [ACCEPT_STOP] nO_ERROR 0 0 0+stopPending = running { currentState = STOP_PENDING+                      , controlsAccepted = []+                      , waitHint = 3000 }+stopped = running { currentState = STOPPED+                  , controlsAccepted = []+                  , waitHint = 3000 }++logExceptions :: Handle -> IO a -> IO a+logExceptions h comp =+    comp `catch`+        \(e :: SomeException) -> do+            hPutStrLn h (show e)+            throwIO e++foreign import stdcall "GetCurrentProcessId" getCurrentProcessId :: IO DWORD++defineService :: Service serviceState -> IO ()+defineService svc = do+    pid <- getCurrentProcessId++    temp <- getTemporaryDirectory++    let logFile = temp </> ("service-debug-" ++ serviceName svc ++ "-" ++ show pid ++ ".log")++    debugH <- openFile logFile WriteMode+    hSetBuffering debugH NoBuffering++    stopSignal <- newEmptyMVar++    startServiceCtrlDispatcher+        (serviceName svc)+        3000+        (handler stopSignal)+        (\_ _ h ->+            logExceptions debugH $ do+                state <- serviceStart svc debugH+                setServiceStatus h running+                takeMVar stopSignal+                serviceStop svc state+                setServiceStatus h stopped+        )