Haskell Windows hizmet uygulaması yazmak için uğraştım.

Arka plan

Servis uygulaması Windows Hizmet Denetim Yöneticisi tarafından yürütülür. Devreye girmesiyle service's main function olarak kullanılacak bir geri arama ile sağlanan StartServiceCtrlDispatcher engelleme çağrısı yapıyor.

Hizmet ana işlevi başlatmak gibi gelen komutları işlemek için ikinci bir geri arama kaydetmek, durdurmak, devam vb gerekiyordu. RegisterServiceCtrlHandler çağırarak bunu yapar.

Sorun

Hizmet ana işlevi kayıt edecek bir program yazmak mümkün değilim. Sonra bir Windows hizmeti olarak programı yüklemek ve Hizmetler Yönetim konsolundan başlayabilirim. Hizmeti başlatmak için, çalışan olarak kendini rapor ve gelen istekleri için bekleyin.

Sorun çağrılacak ** 54 ben gidemiyorum. Hizmet durumu çalıştığı ortaya koymaktadır sorgulama, ama ben send 'komutu, windows bir mesaj açılır: . dur

Windows could not stop the Test service on Local Computer.

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

MSDN documentation göre StartServiceCtrlDispatcher tüm hizmetler durdu düşünüyorlar kadar engeller işlevi. Hizmet ana işlevi çağrılır sonra dağıtıcı bir iş parçacığı, Hizmet Denetim Yöneticisi, bu noktada işleyicisi işlevi bu iş parçacığı tarafından çağrılabilir bir komut gönderene kadar beklemek gerekiyor.

Ayrıntılar

Aşağıda ne yapmaya çalışıyorum ne çok sadeleştirilmiş bir versiyonu, ama eğitmenim fonksiyon problemi " olmadığı gösterir.

İlk olarak, bir kaç isim ve ithalat:

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 ()

Veri sıralama için Depolanabilir örnekleri: birkaç özel veri türlerini tanımlamak gerekiyor

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

Sadece üç yabancı ithalat yapılması gerekir. Bir 'sarıcı' win 32 temin edeceğim iki geri alma: var

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

Ana program

Son olarak, burada ana hizmet uygulaması

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

Çıktı

Daha önce sc create Test binPath= c:\Main.exe kullanarak hizmet yükledim.

İşte program derleme çıktısı:

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

C:\path>

Ben sonra Hizmet Denetim monitörden hizmetini başlatın. Burada SetServiceStatus telefonum kabul edilen kanıt

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>

Burada log.txt, benim ilk geri arama svcMain denilen olduğunu kanıtlayan içeriği:

svcMain: svcMain here!
svcMain: exiting

Stop komutu, Hizmet Denetim Yöneticisi kullanarak gönderin en kısa sürede hata mesajı alıyorum. Benim işleyicisi işlevi günlük dosyasına bir satır eklemek gerekiyordu, ama bu olmaz. Benim hizmeti durduruldu durumuna görünür:

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>

Soru

Kimse benim işleyicisi çağrılacak işlevi elde etmek için deneyebilirsiniz ne için bir fikir var mı?

Güncelleme 20130306

Windows XP üzerinde Windows 7 64-bit, ama şöyle bir sorunum var. Windows'un diğer sürümleri henüz test edilmemiştir. Birden fazla makine için derlenmiş bir yürütülebilir dosyayı kopyala ve aynı adımları gerçekleştirmek zaman farklı sonuçlar alıyorum.

İtiraf etmeliyim ki, bu sorun, bazı günler benim için can sıkıcı olmuştur. Dönüş değerleri ve GetLastError, içeriğini doğru yürürken bu kod sistemine göre çalışması gerektiğini tespit ettik.

Açıkça (başarıyla çalışan hizmet işleyicisi engeller tanımsız bir duruma girmek gibi) olmadığı için, benim tam teşhis ve geçici bir çözüm gönderdiniz. Bu Microsoft arayüzü teminatlarını layık değil, çünkü farkında olmalıdır senaryo kesin.

Muayene

Sonra giderek büyük ölçüde tatminsiz hata iletileri varlık tarafından bildirilen Windows çalıştığım için sorgulama hizmeti () sc interrogate service sc control service ile bir konserve control isteğe izin), yazdığım benim kendi çağrısı GetLastError eğer ilginç bir şey oldu:

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))

Ne ben keşfettim, benim üzmek için çok, ERROR_INVALID_HANDLE and ERROR_ALREADY_EXISTS atılan ediliyordu... appendFile işlemleri sırayla çalıştırın. Yazıklar olsun, burada bir şeyler olduğunu düşündüm.

Bu bana anlat yaptığını, ancak StartServiceCtrlDispatcher, RegisterServiceCtrlHandler SetServiceStatusdeğilhata kodu ayarı; biz ERROR_SUCCESS tam olarak umuyordum.

Analiz

Cesaret verecek, Windows' Görev Yöneticisi ve Sistem RUNNING hizmet kayıt Günlükleri. Yani, denklemin parçası aslında çalışma olduğunu varsayarak, hizmet başımızdaki düzgün vurulduktan değil neden geri dönmek zorundayız.

Bu satırları inceleme:

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

Benim 40* *nullFunPtr enjeksiyon girişiminde bulundum. Cesaret verecek, bu hizmeti START_PENDING devlet asılmasına neden oldu. İyi: fpHandler içeriğini aslında, servis kayıt olurken idare ediliyor demektir.

O zaman, şunu denedim:

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

Ve bu, ne yazık ki, aldı. , 58**: ancak

Eğer hizmeti SERVICE_WIN32_OWN_PROCESS servis kuruluysa yazın bu üye göz ardı edilir, ama BOŞ olamaz. Bu üye olabilir boş bir dize ("").

Bizim bağladım göre GetLastError RegisterServiceCtrlHandler SetServiceStatus döner (geçerli bir SERVICE_STATUS_HANDLE true, sırasıyla), tüm sisteme göre daha iyi. Bu doğru olamaz, ve bu değil neden tamamen opakiş sadece.

Geçerli Bir Geçici Çözüm

Eğer RegisterServiceCtrlHandler içine bildirimi etkin bir şekilde çalışıp çalışmadığını belli değil çünkü, interrogating this branch of your code in a debugger while your service is running ve daha da önemlisi, bu sorun hakkında Microsoft başvurmanızı tavsiye ederim. Söylentiye göre, görünen ettin tatmin işlevsel bağımlılıkları doğru, sistem döner her şey gerektiği için başarılı bir çalışma, ve henüz programınız hala girme tanımlanmamış bir devlet ile net bir çare olarak görme. Bu bir hata değil.

İşe yarar bir çözüm bu arada kullanmaktır Haskell FFI tanımlamak servis mimarisinde başka bir dili (örneğin C ) ve kanca içine kodunuzu ya da (a) teşhir senin Haskell kodu hizmetin katman veya (b) teşhir hizmet kodu Haskell. Her iki durumda da, here's a starting reference to use hizmet binası için.

Daha fazla burada (ben, meşru dürüst çalıştım) yapmış isterdim, ama bu bile çok anlamlı bu çalışma almak size yardımcı olacaktır.

İyi şanslar sana. İnsanlar sonuçlarını ilgi oldukça fazla sayıda var gibi görünüyor.