diff --git a/src/winsvc.ml b/src/winsvc.ml index 0060b7d..ec4eb17 100644 --- a/src/winsvc.ml +++ b/src/winsvc.ml @@ -1,14 +1,14 @@ external install : string -> string -> string -> string -> unit - = "caml_winsvc_install" + = "winsvc_install" -external remove : string -> unit = "caml_winsvc_remove" +external remove : string -> unit = "winsvc_remove" external run : string -> (unit -> unit) -> (unit -> unit) -> unit - = "caml_winsvc_run" + = "winsvc_run" exception Error of string -let () = Callback.register_exception "caml_winsvc_exn" (Error "register"); +let () = Callback.register_exception "winsvc_exn" (Error "register"); module type Sig = sig val name : string diff --git a/src/winsvc.mli b/src/winsvc.mli index 7adf10b..52413f0 100644 --- a/src/winsvc.mli +++ b/src/winsvc.mli @@ -32,6 +32,8 @@ module Make (S : Sig) : sig (** [run main] @param main function to run, stdin/stdout not available (will raise exception if used), - when [S.stop] is called this function should return as soon as possible *) + when [S.stop] is called this function should return as soon as possible. + @raise Failure if the program is being run as a console application rather than as a + service. *) val run : (unit -> unit) -> unit end diff --git a/src/winsvc_stubs.c b/src/winsvc_stubs.c index 40918f0..3097e35 100644 --- a/src/winsvc_stubs.c +++ b/src/winsvc_stubs.c @@ -11,23 +11,28 @@ Adapted for ocaml by ygrek, (c) 2009 */ +#define UNICODE +#define _UNICODE #define WIN32_LEAN_AND_MEAN // Exclude rarely-used stuff from Windows headers #include -#include -#include #include +#define STRSAFE_NO_CCH_FUNCTIONS +#include +#define CAML_NAME_SPACE +#define CAML_INTERNALS #include #include #include #include #include +#include static value cb_service_run = Val_unit; static value cb_service_stop = Val_unit; -static char *s_service_name = NULL; +static char_os *s_service_name = NULL; -void call_service_run(void) { +static void call_service_run(void) { assert(Val_unit != cb_service_run); caml_c_thread_register(); caml_acquire_runtime_system(); @@ -36,7 +41,7 @@ void call_service_run(void) { caml_c_thread_unregister(); } -void call_service_stop(void) { +static void call_service_stop(void) { assert(Val_unit != cb_service_stop); caml_c_thread_register(); @@ -46,11 +51,11 @@ void call_service_stop(void) { caml_c_thread_unregister(); } -static SERVICE_STATUS service_status; -static SERVICE_STATUS_HANDLE handle_service_status = 0; +static SERVICE_STATUS service_status; +static SERVICE_STATUS_HANDLE handle_service_status = 0; static int check_point = 1; -BOOL report_status(DWORD current_state, DWORD win32_exitcode, DWORD wait_hint) { +static BOOL report_status(DWORD current_state, DWORD win32_exitcode, DWORD wait_hint) { if (current_state != SERVICE_START_PENDING) service_status.dwControlsAccepted = SERVICE_ACCEPT_STOP; service_status.dwCurrentState = current_state; @@ -66,13 +71,13 @@ BOOL report_status(DWORD current_state, DWORD win32_exitcode, DWORD wait_hint) { return SetServiceStatus(handle_service_status, &service_status); } -void stop_service() { +static void stop_service() { report_status(SERVICE_STOP_PENDING, NO_ERROR, 1000); call_service_stop(); } -void WINAPI service_ctrl_handler(DWORD ctrl_code) { +static void WINAPI service_ctrl_handler(DWORD ctrl_code) { if (ctrl_code == SERVICE_CONTROL_STOP) { stop_service(); } else { @@ -80,7 +85,7 @@ void WINAPI service_ctrl_handler(DWORD ctrl_code) { } } -void service_main(DWORD argc, TCHAR **argv) { +static void service_main(DWORD argc, WCHAR **argv) { memset(&service_status, 0, sizeof(SERVICE_STATUS)); service_status.dwServiceType = SERVICE_WIN32_OWN_PROCESS; service_status.dwServiceSpecificExitCode = 0; @@ -95,33 +100,69 @@ void service_main(DWORD argc, TCHAR **argv) { report_status(SERVICE_STOPPED, NO_ERROR, 2000); } -#define raise_error(str) caml_raise_with_string(*caml_named_value("caml_service_exn"), str) +static void raise_error(const char_os *prefix, DWORD rc) { + LPVOID buffer = NULL; + char_os msg[2048] = { 0 }; + + FormatMessage( + FORMAT_MESSAGE_ALLOCATE_BUFFER | + FORMAT_MESSAGE_FROM_SYSTEM | + FORMAT_MESSAGE_IGNORE_INSERTS, + NULL, + rc, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), + (LPTSTR) &buffer, + 0, NULL); + StringCbPrintf( + msg, sizeof(msg)/sizeof(msg[0]), + L"%s: %s", + prefix, + buffer); + LocalFree(buffer); + + caml_raise_with_arg(*caml_named_value("winsvc_exn"), + caml_copy_string_of_os(msg)); +} -CAMLprim value caml_winsvc_install(value v_name, value v_display, value v_text, +CAMLprim value winsvc_install(value v_name, value v_display, value v_text, value v_path) { CAMLparam4(v_name, v_display, v_text, v_path); SC_HANDLE handle_manager; SC_HANDLE handle_service; SERVICE_DESCRIPTION description; + char_os *name, *display, *text, *path; + DWORD rc; handle_manager = OpenSCManager(0, 0, SC_MANAGER_ALL_ACCESS); - if (handle_manager == 0) { - raise_error("Failed to open service control manager"); + if (handle_manager == NULL) { + raise_error(L"OpenSCManager", GetLastError()); } + name = caml_stat_strdup_to_os(String_val(v_name)); + display = caml_stat_strdup_to_os(String_val(v_display)); + path = caml_stat_strdup_to_os(String_val(v_path)); + handle_service = CreateService( - handle_manager, String_val(v_name), String_val(v_display), + handle_manager, name, display, SERVICE_ALL_ACCESS, SERVICE_WIN32_OWN_PROCESS, SERVICE_AUTO_START, - SERVICE_ERROR_NORMAL, String_val(v_path), 0, 0, 0, 0, 0); - if (handle_service == 0) { + SERVICE_ERROR_NORMAL, path, 0, 0, 0, 0, 0); + rc = GetLastError(); + + caml_stat_free(name); + caml_stat_free(display); + caml_stat_free(path); + + if (handle_service == NULL) { CloseServiceHandle(handle_manager); - raise_error("Failed to create service in service control manager"); + raise_error(L"CreateService", rc); } - description.lpDescription = String_val(v_text); + text = caml_stat_strdup_to_os(String_val(v_text)); + description.lpDescription = text; ChangeServiceConfig2(handle_service, SERVICE_CONFIG_DESCRIPTION, &description); + caml_stat_free(text); CloseServiceHandle(handle_service); CloseServiceHandle(handle_manager); @@ -129,24 +170,28 @@ CAMLprim value caml_winsvc_install(value v_name, value v_display, value v_text, CAMLreturn(Val_unit); } -CAMLprim value caml_winsvc_remove(value v_name) { +CAMLprim value winsvc_remove(value v_name) { CAMLparam1(v_name); SC_HANDLE handle_manager; SC_HANDLE handle_service; SERVICE_STATUS status; BOOL result; + char_os *name; + DWORD rc; handle_manager = OpenSCManager(0, 0, SC_MANAGER_ALL_ACCESS); - if (handle_manager == 0) { - raise_error("Failed to open service control manager"); + if (handle_manager == NULL) { + raise_error(L"OpenSCManager", GetLastError()); } + name = caml_stat_strdup_to_os(String_val(v_name)); handle_service = - OpenService(handle_manager, String_val(v_name), SERVICE_ALL_ACCESS); - if (handle_service == 0) { + OpenService(handle_manager, name, SERVICE_ALL_ACCESS); + caml_stat_free(name); + if (handle_service == NULL) { CloseServiceHandle(handle_manager); - raise_error("Failed to open service in service control manager"); + raise_error(L"OpenService", GetLastError()); } memset(&status, 0, sizeof(SERVICE_STATUS)); @@ -160,28 +205,29 @@ CAMLprim value caml_winsvc_remove(value v_name) { } result = DeleteService(handle_service); + rc = GetLastError(); CloseServiceHandle(handle_service); CloseServiceHandle(handle_manager); - if (0 == result) { - raise_error("Failed to remove service"); + if (!result) { + raise_error(L"DeleteService", rc); } CAMLreturn(Val_unit); } -CAMLprim value caml_winsvc_run(value v_name, value v_run, value v_stop) { +CAMLprim value winsvc_run(value v_name, value v_run, value v_stop) { CAMLparam3(v_name, v_run, v_stop); BOOL result; - // not sure whether it is needed but better stay on the safe side - char *s_name = strdup(String_val(v_name)); + char_os *s_name = caml_stat_strdup_to_os(String_val(v_name)); SERVICE_TABLE_ENTRY dispatch_table[] = { {s_name, (LPSERVICE_MAIN_FUNCTION)service_main}, {0, 0}}; + DWORD rc; if (Val_unit != cb_service_run) { - free(s_name); - raise_error("Already running"); + caml_stat_free(s_name); + caml_raise_with_string(*caml_named_value("winsvc_exn"), "Already running"); } s_service_name = s_name; @@ -193,6 +239,7 @@ CAMLprim value caml_winsvc_run(value v_name, value v_run, value v_stop) { caml_release_runtime_system(); result = StartServiceCtrlDispatcher(dispatch_table); + rc = GetLastError(); caml_acquire_runtime_system(); caml_remove_generational_global_root(&cb_service_run); @@ -201,11 +248,14 @@ CAMLprim value caml_winsvc_run(value v_name, value v_run, value v_stop) { cb_service_stop = Val_unit; s_service_name = NULL; + caml_stat_free(s_name); - free(s_name); - - if (FALSE == result) - raise_error("Failed to run service"); + if (!result) { + if (rc == ERROR_FAILED_SERVICE_CONTROLLER_CONNECT) + caml_failwith("ERROR_FAILED_SERVICE_CONTROLLER_CONNECT"); + else + raise_error(L"StartServiceCtrlDispatcher", rc); + } CAMLreturn(Val_unit); }