wip

src/Main.hs

@@ -3,41 +3,74 @@
 
 module Main (main) where
 
+import Control.Applicative ((<$>))
+import Control.Exception (throw)
 import Control.Concurrent
+import Control.Monad (forever)
+import System.Environment (getArgs)
 import System.Win32.SystemServices.Services
 import System.Win32.Types
 
+import Control.Distributed.Process
+import Control.Distributed.Process.Node
+import Network.Transport.TCP
+
+import Network (withSocketsDo)
+
 main :: IO ()
-main = do
-    gState <- newMVar (1, SERVICE_STATUS WIN32_OWN_PROCESS
-                          START_PENDING [] nO_ERROR 0 0 3000)
-    mStop <- newEmptyMVar
+main = withSocketsDo $ do
+    args <- getArgs
+    case args of
+      ["--service"] -> runService
+      ["--server"]  -> runServer
+      xs            -> runClient xs
+
+------------------------------------------------------------------------
+-- Client
+
+runClient :: [String] -> IO ()
+runClient _ = do
+    transport <- either throw id <$>
+                 createTransport "localhost" "30020" defaultTCPParameters
+    node <- newLocalNode transport initRemoteTable
+    runProcess node $ do
+        return ()
+
+------------------------------------------------------------------------
+-- Server
+
+runServer :: IO ()
+runServer = do
+    forkServer
+    putStrLn "Running sudo server..."
+    forever $ threadDelay 1000000
+
+forkServer :: IO ProcessId
+forkServer = do
+    transport <- either throw id <$>
+                 createTransport "localhost" "30020" defaultTCPParameters
+    node <- newLocalNode transport initRemoteTable
+    print (localNodeId node)
+    forkProcess node $ forever $ do
+        str <- expect
+        liftIO (putStrLn str)
+
+------------------------------------------------------------------------
+-- Windows Service
+
+runService :: IO ()
+runService = do
+    gState <- newMVar (1, SERVICE_STATUS WIN32_OWN_PROCESS START_PENDING [] nO_ERROR 0 0 3000)
+    mStop  <- newEmptyMVar
     startServiceCtrlDispatcher "sudo4win" 3000
         (svcCtrlHandler mStop gState)
         (svcMain        mStop gState)
 
-
 svcMain :: MVar () -> MVar (DWORD, SERVICE_STATUS) -> ServiceMainFunction
 svcMain mStop gState _ _ h = do
     reportSvcStatus h RUNNING nO_ERROR 0 gState
-    appendFile "c:\\test.txt" "1"
-    threadDelay 1000000
-    appendFile "c:\\test.txt" "2"
-    threadDelay 1000000
-    appendFile "c:\\test.txt" "3"
-    threadDelay 1000000
-    appendFile "c:\\test.txt" "4"
-    threadDelay 1000000
-    appendFile "c:\\test.txt" "5"
+    forkServer
     takeMVar mStop
-    threadDelay 1000000
-    appendFile "c:\\test.txt" "."
-    threadDelay 1000000
-    appendFile "c:\\test.txt" "."
-    threadDelay 1000000
-    appendFile "c:\\test.txt" "."
-    threadDelay 1000000
-    appendFile "c:\\test.txt" "Stahp\n"
     reportSvcStatus h STOPPED nO_ERROR 0 gState
 
 reportSvcStatus :: HANDLE -> SERVICE_STATE -> DWORD -> DWORD

sudo4win.cabal

@@ -10,14 +10,17 @@ build-type:    Simple
 cabal-version: >=1.6
 
 
-Executable sudo4win
+Executable sudo
   main-is: Main.hs
   hs-source-dirs: src
 
   build-depends:
-      base           == 4.*
-    , Win32          == 2.3.*
-    , Win32-services == 0.2.*
+      base                  == 4.*
+    , distributed-process   == 0.4.*
+    , network-transport-tcp == 0.3.*
+    , network
+    , Win32
+    , Win32-services        == 0.2.*
 
   ghc-options: -Wall -threaded
   ld-options: -enable-stdcall-fixup