Databases
StackOverflow2013
Postsdbo
POHow can a Windows service application be written in Haskell?
 

Note that there are some explanatory texts on larger screens.

plurals
  1. POHow can a Windows service application be written in Haskell?
    primarykey
    data
    text
    <p>I've been struggling to write a Windows service application in Haskell.</p> <h2>Background</h2> <p>A service application is executed by the Windows Service Control Manager. Upon launching it makes a blocking call to <a href="http://msdn.microsoft.com/en-us/library/windows/desktop/ms686324%28v=vs.85%29.aspx">StartServiceCtrlDispatcher</a> which is supplied with a callback to be used as the <a href="http://msdn.microsoft.com/en-us/library/windows/desktop/ms685138%28v=vs.85%29.aspx">service's main function</a>.</p> <p>The service's main function is supposed to register a second callback to handle incoming commands such as start, stop, continue etc. It does this by calling <a href="http://msdn.microsoft.com/en-us/library/windows/desktop/ms685054%28v=vs.85%29.aspx">RegisterServiceCtrlHandler</a>.</p> <h2>Problem</h2> <p>I'm able to write a program which will register a service main function. I can then install the program as a Windows service and start it from the Services Management Console. The service is able to start, report itself as running, and then wait for incoming requests.</p> <p>The problem is that I'm unable to get my <a href="http://msdn.microsoft.com/en-us/library/windows/desktop/ms683240%28v=vs.85%29.aspx">service handler function</a> to be called. Querying the services status reveals that it is running, but as soon as I send it a 'stop' command windows pops up a message saying:</p> <pre><code>Windows could not stop the Test service on Local Computer. Error 1061: The service cannot accept control messages at this time. </code></pre> <p>According to <a href="http://msdn.microsoft.com/en-us/library/windows/desktop/ms685141%28v=vs.85%29.aspx">MSDN documentation</a> the StartServiceCtrlDispatcher function blocks until all services report that they are stopped. After the service main function gets called a dispatcher thread is supposed to wait until the Service Control Manager sends a command, at which point the handler function should be called by that thread.</p> <h2>Details</h2> <p>What follows is a very simplified version of what I am trying to do, but it demonstrates the problem of my handler function not being called.</p> <p>First, a few names and imports:</p> <pre><code>module Main where import Control.Applicative import Foreign import System.Win32 wIN32_OWN_PROCESS :: DWORD wIN32_OWN_PROCESS = 0x00000010 sTART_PENDING, rUNNING :: DWORD sTART_PENDING = 0x00000002 rUNNING = 0x00000004 aCCEPT_STOP, aCCEPT_NONE :: DWORD aCCEPT_STOP = 0x00000001 aCCEPT_NONE = 0x00000000 nO_ERROR :: DWORD nO_ERROR = 0x00000000 type HANDLER_FUNCTION = DWORD -&gt; IO () type MAIN_FUNCTION = DWORD -&gt; Ptr LPTSTR -&gt; IO () </code></pre> <p>I need to define a few special data types with Storable instances for data marshalling:</p> <pre><code>data TABLE_ENTRY = TABLE_ENTRY LPTSTR (FunPtr MAIN_FUNCTION) instance Storable TABLE_ENTRY where sizeOf _ = 8 alignment _ = 4 peek ptr = TABLE_ENTRY &lt;$&gt; peek (castPtr ptr) &lt;*&gt; peek (castPtr ptr `plusPtr` 4) poke ptr (TABLE_ENTRY name proc) = do poke (castPtr ptr) name poke (castPtr ptr `plusPtr` 4) proc data STATUS = STATUS DWORD DWORD DWORD DWORD DWORD DWORD DWORD instance Storable STATUS where sizeOf _ = 28 alignment _ = 4 peek ptr = STATUS &lt;$&gt; peek (castPtr ptr) &lt;*&gt; peek (castPtr ptr `plusPtr` 4) &lt;*&gt; peek (castPtr ptr `plusPtr` 8) &lt;*&gt; peek (castPtr ptr `plusPtr` 12) &lt;*&gt; peek (castPtr ptr `plusPtr` 16) &lt;*&gt; peek (castPtr ptr `plusPtr` 20) &lt;*&gt; peek (castPtr ptr `plusPtr` 24) poke ptr (STATUS a b c d e f g) = do poke (castPtr ptr) a poke (castPtr ptr `plusPtr` 4) b poke (castPtr ptr `plusPtr` 8) c poke (castPtr ptr `plusPtr` 12) d poke (castPtr ptr `plusPtr` 16) e poke (castPtr ptr `plusPtr` 20) f poke (castPtr ptr `plusPtr` 24) g </code></pre> <p>Only three foreign imports need to be made. There's a 'wrapper' import for the two callbacks I'll be supplying to Win32:</p> <pre><code>foreign import stdcall "wrapper" smfToFunPtr :: MAIN_FUNCTION -&gt; IO (FunPtr MAIN_FUNCTION) foreign import stdcall "wrapper" handlerToFunPtr :: HANDLER_FUNCTION -&gt; IO (FunPtr HANDLER_FUNCTION) foreign import stdcall "windows.h RegisterServiceCtrlHandlerW" c_RegisterServiceCtrlHandler :: LPCTSTR -&gt; FunPtr HANDLER_FUNCTION -&gt; IO HANDLE foreign import stdcall "windows.h SetServiceStatus" c_SetServiceStatus :: HANDLE -&gt; Ptr STATUS -&gt; IO BOOL foreign import stdcall "windows.h StartServiceCtrlDispatcherW" c_StartServiceCtrlDispatcher :: Ptr TABLE_ENTRY -&gt; IO BOOL </code></pre> <h2>Main program</h2> <p>Finally, here is the main service application:</p> <pre><code>main :: IO () main = withTString "Test" $ \name -&gt; smfToFunPtr svcMain &gt;&gt;= \fpMain -&gt; withArray [TABLE_ENTRY name fpMain, TABLE_ENTRY nullPtr nullFunPtr] $ \ste -&gt; c_StartServiceCtrlDispatcher ste &gt;&gt; return () svcMain :: MAIN_FUNCTION svcMain argc argv = do appendFile "c:\\log.txt" "svcMain: svcMain here!\n" args &lt;- peekArray (fromIntegral argc) argv fpHandler &lt;- handlerToFunPtr svcHandler h &lt;- c_RegisterServiceCtrlHandler (head args) fpHandler _ &lt;- setServiceStatus h running appendFile "c:\\log.txt" "svcMain: exiting\n" svcHandler :: DWORD -&gt; IO () svcHandler _ = appendFile "c:\\log.txt" "svcCtrlHandler: received.\n" setServiceStatus :: HANDLE -&gt; STATUS -&gt; IO BOOL setServiceStatus h status = with status $ c_SetServiceStatus h running :: STATUS running = STATUS wIN32_OWN_PROCESS rUNNING aCCEPT_STOP nO_ERROR 0 0 3000 </code></pre> <h2>Output</h2> <p>I've previously installed the service using <code>sc create Test binPath= c:\Main.exe</code>.</p> <p>Here is the output from compiling the program:</p> <pre><code>C:\path&gt;ghc -threaded --make Main.hs [1 of 1] Compiling Main ( Main.hs, Main.o ) Linking Main.exe ... C:\path&gt; </code></pre> <p>I then start the service from the Service Control Monitor. Here is proof that my call to SetServiceStatus was accepted:</p> <pre><code>C:\Path&gt;sc query Test SERVICE_NAME: Test TYPE : 10 WIN32_OWN_PROCESS STATE : 4 RUNNING (STOPPABLE, NOT_PAUSABLE, IGNORES_SHUTDOWN) WIN32_EXIT_CODE : 0 (0x0) SERVICE_EXIT_CODE : 0 (0x0) CHECKPOINT : 0x0 WAIT_HINT : 0x0 C:\Path&gt; </code></pre> <p>Here is the contents of <code>log.txt</code>, proving that my first callback, <code>svcMain</code>, was called:</p> <pre><code>svcMain: svcMain here! svcMain: exiting </code></pre> <p>As soon as I send a stop command using the Service Control Manager I get my error message. My handler function was supposed to add a line to the log file, but this does not happen. My service then appears in the stopped state:</p> <pre><code>C:\Path&gt;sc query Test SERVICE_NAME: Test TYPE : 10 WIN32_OWN_PROCESS STATE : 1 STOPPED WIN32_EXIT_CODE : 0 (0x0) SERVICE_EXIT_CODE : 0 (0x0) CHECKPOINT : 0x0 WAIT_HINT : 0x0 C:\Path&gt; </code></pre> <h2>Question</h2> <p>Does anyone have ideas for what I may try to get my handler function to be called?</p> <h2>Update 20130306</h2> <p>I have this problem on Windows 7 64-bit, but not on Windows XP. Other versions of Windows have not been tested yet. When I copy the compiled executable to multiple machines and perform the same steps I get different results.</p>
    singulars
    1. PO
      singulars
      1. PTAnswer
    1. This table or related slice is empty.
    1. PTQuestion
    1. USMichael Steele
    1. USMichael Steele
    plurals
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. PO
      singulars
      1. PTAnswer
    2. PO
      singulars
      1. PTAnswer
    3. PO
      singulars
      1. PTAnswer
    1. VO
      singulars
      1. POHow can a Windows service application be written in Haskell?
      1. This table or related slice is empty.
      1. VTUpMod
    2. VO
      singulars
      1. POHow can a Windows service application be written in Haskell?
      1. This table or related slice is empty.
      1. VTUpMod
    3. VO
      singulars
      1. POHow can a Windows service application be written in Haskell?
      1. This table or related slice is empty.
      1. VTUpMod
    1. CO+1, very nice question. I presume this hasn't been solved, given the addition of the bounty. I'll look at this later.
      singulars
      1. POHow can a Windows service application be written in Haskell?
      1. USMrGomez
    2. COSorry, but I don't see that your `svcHandler` implementation call `SetServiceStatus` to report the `SERVICE_STOPPED` status of the service. Another question: do you seen in the log file the message "svcCtrlHandler: received.\n"? By the way I recommend you to use `sc interrogate Test` to verify that `svcHandler` are correct registered. If the `svcHandler` receive the `SERVICE_CONTROL_INTERROGATE` (4) as the input it should call `SetServiceStatus` in the same way as `svcMain` to use report the status `rUNNING` (`SERVICE_RUNNING`) and which controls it accept (`aCCEPT_STOP`).
      singulars
      1. POHow can a Windows service application be written in Haskell?
      1. USOleg
    3. CO@Oleg This example's handler isn't doing anything in order to keep things simple. As far as I can see it's not even being called. I have not tried manually interrogating the service, but will do so. My log file does not contain the expected output.
      singulars
      1. POHow can a Windows service application be written in Haskell?
      1. USMichael Steele
 

Querying!

 
Guidance
A row detail

Detail views are divided into sections. All the information in the data section comes from columns in the selected row. The other sections display data from other, related rows.

Related data can be related in a to-one or a to-many fashion. Captions of data related in a to-many fashion link to a list view showing a filtered view of the table.

Try moving around until you find a non-empty to-many entry and click on the label to get to one. You can move back to the root by clicking on the database name in the header.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload