winapi - name - que es meta description en wordpress

¿Cómo se puede escribir una aplicación de servicio de Windows en Haskell?

Question

He estado luchando por escribir una aplicación de servicio de Windows en Haskell.

Fondo

El Administrador de control de servicios de Windows ejecuta una aplicación de servicio. Tras el lanzamiento, realiza una llamada de bloqueo a StartServiceCtrlDispatcher que se suministra con una devolución de llamada que se utilizará como la función principal del servicio .

Se supone que la función principal del servicio registra una segunda devolución de llamada para manejar los comandos entrantes, como iniciar, detener, continuar, etc. Lo hace llamando a RegisterServiceCtrlHandler .

Problema

Puedo escribir un programa que registrará una función principal del servicio. Luego puedo instalar el programa como un servicio de Windows e iniciarlo desde la consola de administración de servicios. El servicio puede iniciarse, informarse como en ejecución y luego esperar las solicitudes entrantes.

El problema es que no puedo llamar a mi función de controlador de servicio . Consultar el estado de los servicios revela que se está ejecutando, pero tan pronto como lo envío una ventana de comando ''detener'' aparece un mensaje que dice:

Windows could not stop the Test service on Local Computer.

Error 1061: The service cannot accept control messages at this time.

Según la documentación de MSDN, la función StartServiceCtrlDispatcher bloquea hasta que todos los servicios informan que están detenidos. Después de que se llame a la función principal del servicio, se espera que un subproceso de distribución espere hasta que el Administrador de control de servicios envíe un comando, momento en el cual la función del gestor debe ser llamada por ese subproceso.

Detalles

Lo que sigue es una versión muy simplificada de lo que estoy tratando de hacer, pero demuestra el problema de que no se llama a mi función de controlador.

Primero, algunos nombres e importaciones:

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 -> IO ()
type MAIN_FUNCTION = DWORD -> Ptr LPTSTR -> IO ()

Necesito definir algunos tipos de datos especiales con instancias almacenables para la clasificación de datos:

data TABLE_ENTRY = TABLE_ENTRY LPTSTR (FunPtr MAIN_FUNCTION)

instance Storable TABLE_ENTRY where
  sizeOf _ = 8
  alignment _ = 4
  peek ptr = TABLE_ENTRY <$> peek (castPtr ptr) <*> 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 
      <$> peek (castPtr ptr)
      <*> peek (castPtr ptr `plusPtr` 4)
      <*> peek (castPtr ptr `plusPtr` 8)
      <*> peek (castPtr ptr `plusPtr` 12)
      <*> peek (castPtr ptr `plusPtr` 16)
      <*> peek (castPtr ptr `plusPtr` 20)
      <*> 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

Solo se necesitan tres importaciones extranjeras. Hay una importación ''envoltura'' para las dos devoluciones de llamada que suministraré a Win32:

foreign import stdcall "wrapper"
    smfToFunPtr :: MAIN_FUNCTION -> IO (FunPtr MAIN_FUNCTION)
foreign import stdcall "wrapper"
    handlerToFunPtr :: HANDLER_FUNCTION -> IO (FunPtr HANDLER_FUNCTION)
foreign import stdcall "windows.h RegisterServiceCtrlHandlerW"
    c_RegisterServiceCtrlHandler
        :: LPCTSTR -> FunPtr HANDLER_FUNCTION -> IO HANDLE
foreign import stdcall "windows.h SetServiceStatus"
    c_SetServiceStatus :: HANDLE -> Ptr STATUS -> IO BOOL
foreign import stdcall "windows.h StartServiceCtrlDispatcherW"
    c_StartServiceCtrlDispatcher :: Ptr TABLE_ENTRY -> IO BOOL

Programa principal

Finalmente, aquí está la aplicación de servicio principal:

main :: IO ()
main =
  withTString "Test" $ /name ->
  smfToFunPtr svcMain >>= /fpMain ->
  withArray [TABLE_ENTRY name fpMain, TABLE_ENTRY nullPtr nullFunPtr] $ /ste ->
  c_StartServiceCtrlDispatcher ste >> return ()

svcMain :: MAIN_FUNCTION
svcMain argc argv = do
    appendFile "c://log.txt" "svcMain: svcMain here!/n"
    args <- peekArray (fromIntegral argc) argv
    fpHandler <- handlerToFunPtr svcHandler
    h <- c_RegisterServiceCtrlHandler (head args) fpHandler
    _ <- setServiceStatus h running
    appendFile "c://log.txt" "svcMain: exiting/n"

svcHandler :: DWORD -> IO ()
svcHandler _ = appendFile "c://log.txt" "svcCtrlHandler: received./n"

setServiceStatus :: HANDLE -> STATUS -> 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

Salida

Anteriormente instalé el servicio utilizando sc create Test binPath= c:/Main.exe .

Aquí está el resultado de compilar el programa:

C:/path>ghc -threaded --make Main.hs
[1 of 1] Compiling Main             ( Main.hs, Main.o )
Linking Main.exe ...

C:/path>

Luego, comienzo el servicio desde el Monitor de control de servicio. Aquí hay una prueba de que mi llamada a SetServiceStatus fue aceptada:

C:/Path>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>

Aquí está el contenido de log.txt , demostrando que mi primera devolución de llamada, svcMain , se llamó:

svcMain: svcMain here!
svcMain: exiting

Tan pronto como envíe un comando de detención utilizando el Administrador de control de servicios, aparece mi mensaje de error. Se suponía que mi función de controlador agregaba una línea al archivo de registro, pero esto no ocurre. Mi servicio aparece en estado detenido:

C:/Path>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>

Pregunta

¿Alguien tiene ideas para lo que puedo tratar de llamar a mi función de controlador?

Actualización 20130306

Tengo este problema en Windows 7 de 64 bits, pero no en Windows XP. Otras versiones de Windows aún no han sido probadas. Cuando copio el ejecutable compilado en varias máquinas y realizo los mismos pasos, obtengo resultados diferentes.

Answer 1

¿No sería más fácil escribir la parte que interactúa con el servicio en C y hacer que se llame a una DLL escrita en Haskell?

Answer 2

Lo admito, este problema me ha estado molestando por algunos días. Al recorrer los valores de devolución y los contenidos de GetLastError , determiné que este código debería funcionar correctamente según el sistema.

Como claramente no lo es (parece entrar en un estado indefinido que impide que el controlador de servicio se ejecute correctamente), publiqué mi diagnóstico completo y una solución alternativa. Este es el tipo exacto de escenario que Microsoft debe conocer, porque sus garantías de interfaz no se cumplen.

Inspección

Después de quedarme muy insatisfecho con los mensajes de error informados por Windows cuando intenté interrogar al servicio (a través del sc interrogate service y el sc control service con una opción de control enlatado), escribí mi propia llamada en GetLastError para ver si algo interesante estaba sucediendo. en:

import Text.Printf
import System.Win32

foreign import stdcall "windows.h GetLastError"
    c_GetLastError :: IO DWORD 

...

d <- c_GetLastError
appendFile "c://log.txt" (Text.Printf.printf "%d/n" (fromEnum d))

Lo que descubrí, para mi disgusto, fue que ERROR_ALREADY_EXISTS y ERROR_ALREADY_EXISTS estaban siendo lanzados ... cuando ejecutas tus operaciones appendFile secuencialmente. Phooey, y aquí pensé que estaba en algo.

Lo que sí me dijo, sin embargo, es que StartServiceCtrlDispatcher , RegisterServiceCtrlHandler y SetServiceStatus no están configurando un código de error; de hecho, recibo ERROR_SUCCESS exactamente como esperaba.

Análisis

Es alentador que el Administrador de tareas de Windows y los Registros del sistema registren el servicio como RUNNING . Entonces, suponiendo que esa parte de la ecuación realmente funciona, debemos regresar a por qué nuestro controlador de servicio no recibe el golpe correcto.

Inspeccionando estas líneas:

fpHandler <- handlerToFunPtr svcHandler
h <- c_RegisterServiceCtrlHandler (head args) fpHandler
_ <- setServiceStatus h running

nullFunPtr inyectar nullFunPtr como mi fpHandler . Alentadoramente, esto causó que el servicio se cuelgue en el estado START_PENDING . Bueno: eso significa que los contenidos de fpHandler realidad se están manejando cuando registramos el servicio.

Entonces, intenté esto:

t <- newTString "Foo"
h <- c_RegisterServiceCtrlHandler t fpHandler

Y esto, por desgracia, tomó. Sin embargo, eso es esperado :

Si el servicio se instala con el tipo de servicio SERVICE_WIN32_OWN_PROCESS , este miembro se ignora, pero no puede ser NULL. Este miembro puede ser una cadena vacía ("").

De acuerdo con nuestro GetLastError enganchado y las devoluciones de RegisterServiceCtrlHandler y SetServiceStatus (un SERVICE_STATUS_HANDLE válido y true , respectivamente), todo está bien de acuerdo con el sistema. Eso no puede ser correcto, y es completamente opaco por qué esto no solo funciona .

Solución actual

Debido a que no está claro si su declaración en RegisterServiceCtrlHandler está funcionando de manera efectiva, le recomiendo que interrogue esta rama de su código en un depurador mientras se está ejecutando su servicio y, lo que es más importante, comuníquese con Microsoft sobre este problema. Según todas las cuentas, parece que ha satisfecho todas las dependencias funcionales correctamente, el sistema devuelve todo lo que debería para una ejecución exitosa, y aún su programa todavía está ingresando en un estado indefinido sin un remedio claro a la vista. Eso es un error.

Una solución utilizable mientras tanto es usar Haskell FFI para definir su arquitectura de servicio en otro idioma (por ejemplo, C ++) y engancharlo en (a) exponer su código Haskell a su capa de servicio o (b) exponer su servicio código para Haskell. En ambos casos, aquí hay una referencia inicial para usar para construir su servicio.

Ojalá pudiera haber hecho más aquí (honestamente, lo he intentado legítimamente), pero incluso esto debería ayudarte significativamente a hacer que esto funcione.

La mejor de las suertes para ti. Parece que tienes un número bastante grande de personas interesadas en tus resultados.

Answer 3

Pude resolver este problema y lancé una biblioteca en hackage, Win32-services , para escribir aplicaciones de servicio de Windows en Haskell.

La solución fue usar ciertas combinaciones de llamadas Win32 juntas, evitando otras combinaciones.