mongrel_service 0.3.4-x86-mingw32

data/lib/ServiceFB/ServiceFB.bi

@@ -0,0 +1,109 @@
+'#--
+'# Copyright (c) 2006-2007 Luis Lavena, Multimedia systems
+'#
+'# This source code is released under the MIT License.
+'# See MIT-LICENSE file for details
+'#++
+
+#if __FB_VERSION__ < "0.17"
+#error ServiceFB is designed to compile with FreeBASIC version "0.17"
+#else
+
+#ifndef __FB_WIN32__
+#error Platform unsupported. Compiling ServiceFB requires Windows platform.
+#else
+
+#ifndef __ServiceFB_bi__
+#define __ServiceFB_bi__
+
+#include once "windows.bi"
+#inclib "advapi32"
+
+namespace fb
+namespace svc   '# fb.svc
+#ifdef SERVICEFB_DEBUG_LOG
+    '# debug print
+    declare sub _dprint(byref as string)
+#else
+    #define _dprint(message)
+#endif
+    
+    '# service states used by end user with 'state' property
+    enum ServiceStateEnum
+        Running = SERVICE_RUNNING
+        Paused = SERVICE_PAUSED
+        Stopped = SERVICE_STOPPED
+    end enum
+    
+    
+    '# ServiceProcess type (object)
+    '# use this to create new services and reference the on*() methods to perform the related
+    '# tasks.
+    type ServiceProcess
+        '# ctor/dtor
+        declare constructor()
+        declare constructor(byref as string)
+        declare destructor()
+        
+        '# methods (public)
+        declare sub Run()
+        declare sub StillAlive(byval as integer = 10)
+        
+        '# helper methods (private)
+        declare sub UpdateState(byval as DWORD, byval as integer = 0, byval as integer = 0)
+        
+        '# pseudo-events
+        '# for onInit you should return FALSE (0) in case you want to abort
+        '# service initialization.
+        '# If everything was ok, then return TRUE (-1)
+        onInit          as function(byref as ServiceProcess) as integer
+        onStart         as sub(byref as ServiceProcess)
+        onStop          as sub(byref as ServiceProcess)
+        onPause         as sub(byref as ServiceProcess)
+        onContinue      as sub(byref as ServiceProcess)
+        
+        '# call_* are used to avoid the warning arround ThreadCreate
+        declare static sub call_onStart(byval as any ptr)
+        
+        '# properties (public)
+        name            as string
+        description     as string
+        state           as ServiceStateEnum
+        commandline     as string                   '# TODO
+        shared_process  as integer
+        
+        '# properties (private)
+        _svcStatus      as SERVICE_STATUS
+        _svcHandle      as SERVICE_STATUS_HANDLE
+        _svcStopEvent   as HANDLE
+        _threadHandle   as any ptr
+    end type
+    
+    
+    '# ServiceHost type (object)
+    '# use this, beside ServiceProcess, to manage the registration and running of
+    '# several services sharing the same process.
+    '# NOTE: ServiceHost.Run() and ServiceProcess.Run() are mutually exclusive, that
+    '# means don't mix single service with multiple service in the same program!
+    type ServiceHost
+        '# ctor/dtor()
+        declare constructor()
+        declare destructor()
+        
+        '# methods (public)
+        declare sub Add(byref as ServiceProcess)
+        declare sub Run()
+        
+        '# properties (public)
+        count           as integer
+    end type
+end namespace   '# fb.svc
+end namespace   '# fb
+
+#ifdef SERVICEFB_INCLUDE_UTILS
+#include once "ServiceFB_Utils.bi"
+#endif
+
+#endif '# __ServiceFB_bi__
+#endif '# __FB_WIN32__
+#endif '# __FB_VERSION__

data/lib/ServiceFB/ServiceFB_Utils.bas

@@ -0,0 +1,480 @@
+'#--
+'# Copyright (c) 2006-2007 Luis Lavena, Multimedia systems
+'#
+'# This source code is released under the MIT License.
+'# See MIT-LICENSE file for details
+'#++
+
+#include once "ServiceFB.bi"
+#include once "_internals.bi"
+#include once "ServiceFB_Utils.bi"
+#include once "_utils_internals.bi"
+
+namespace fb
+namespace svc
+namespace utils   '# fb.svc.utils
+    '# private (internals) for ServiceProcess.Console()
+    dim shared _svc_stop_signal as any ptr
+    dim shared _svc_in_console as ServiceProcess ptr
+    dim shared _svc_in_console_stop_flag as BOOL
+    
+    '#####################
+    '# ServiceController
+    '# ctor()
+    constructor ServiceController()
+        with this
+            .product = "My Product"
+            .version = "v0.1"
+            .copyright = "my copyright goes here."
+        end with
+    end constructor
+    
+    
+    '# ctor(product)
+    constructor ServiceController(byref new_product as string)
+        this.product = new_product
+    end constructor
+    
+    
+    '# ctor(product, version)
+    constructor ServiceController(byref new_product as string, byref new_version as string)
+        constructor(new_product)
+        this.version = new_version
+    end constructor
+    
+    
+    '# ctor(product, version, copyright)
+    constructor ServiceController(byref new_product as string, byref new_version as string, byref new_copyright as string)
+        constructor(new_product, new_version)
+        this.copyright = new_copyright
+    end constructor
+    
+    
+    '# dtor()
+    destructor ServiceController()
+    end destructor
+    
+    
+    '# Banner() will display in the console, information regarding your program
+    '# using this formatting:
+    '# 'Product', 'Version'
+    '# 'Copyright'
+    sub ServiceController.Banner()
+        '# display Product and Version
+        print this.product; ", "; this.version
+        print this.copyright
+        print ""
+        '# leave a empty line between banner (header) and other info
+    end sub
+    
+    
+    '# RunMode() provide a simple way to get (*you*) from where this process was started
+    '# and do the corresponding action.
+    function ServiceController.RunMode() as ServiceRunMode
+        dim result as ServiceRunMode
+        dim currPID as DWORD
+        dim parent_pid as uinteger
+        dim parent_name as string
+        dim start_mode as string
+        
+        _dprint("ServiceController.RunMode()")
+        
+        '# get this process PID
+        currPID = GetCurrentProcessId()
+        _dprint("CurrentPID: " + str(currPID))
+        
+        '# get the parent PID
+        parent_pid = _parent_pid(currPID)
+        _dprint("ParentPID: " + str(parent_pid))
+        
+        '# now the the name
+        parent_name = _process_name(parent_pid)
+        if (parent_name = "<unknown>") then
+          parent_name = _process_name_dyn_psapi(parent_pid)
+        end if
+        _dprint("Parent Name: " + parent_name)
+        
+        '# this process started as service?
+        '# that means his parent is services.exe
+        if (parent_name = "services.exe") then
+            result = RunAsService
+        else
+            '# ok, it didn't start as service, analyze command line then
+            start_mode = lcase(trim(command(1)))
+            if (start_mode = "manage") then 
+                '# start ServiceController.Manage()
+                result = RunAsManager
+            elseif (start_mode = "console") then
+                '# start ServiceController.Console()
+                result = RunAsConsole
+            else
+                '# ok, the first paramenter in the commandline didn't work,
+                '# report back so we could send the banner!
+                result = RunAsUnknown
+            end if
+        end if
+        
+        _dprint("ServiceController.RunMode() done")
+        return result
+    end function
+    
+    
+    '# Manage will offer the user (end-user) option in the commandline to
+    '# install, remove, start, stop and query the status of the installed service
+    '# use Manage() when you code a multi-services (ServiceHost) based programs
+    '# for single services, use Manage(service)
+    sub ServiceController.Manage()
+    end sub
+    
+    
+    '# this is used when you want management capabilities for your service
+    '# use this for single services, or call Manage() for multi services 
+    sub ServiceController.Manage(byref service as ServiceProcess)
+    end sub
+    
+    
+    '# this offer the user a way to test/debug your service or run it like a normal
+    '# program, from the command line
+    '# will let you SHUTDOWN the service using CTRL+C
+    '# use this for multi-services (ServiceHost) based programs
+    sub ServiceController.Console()
+        dim working_thread as any ptr
+        dim run_mode as string
+        dim service_name as string
+        dim service as ServiceProcess ptr
+        dim commandline as string
+        dim success as integer
+        
+        _dprint("ServiceController.Console()")
+        
+        '# show the controller banner
+        this.Banner()
+        
+        '# determine how many service exist in references
+        if (_svc_references_count > 0) then
+            _build_commandline(run_mode, service_name, commandline)
+            service = _find_in_references(service_name)
+            
+            if (service = 0) then
+                '# no valid service reference, list available services
+                _list_references()
+            else
+                '# build the command line, excluding 'console' and service_name
+                service->commandline = commandline
+                
+                '# got a service reference
+                '# also, set the global handler that will be used by _control_handler
+                _svc_in_console = service
+                
+                '# create the signal used to stop the service thread.
+                _svc_stop_signal = condcreate()
+                
+                '# register the Console Handler
+                SetConsoleCtrlHandler(@_console_handler, TRUE)
+                
+                print "Starting service '"; service_name; "' in console mode, please wait..."
+                
+                '# onInit should be started inline,
+                '# and its result validated!
+                if not (service->onInit = 0) then
+                    success = service->onInit(*service)
+                end if
+                
+                '# only continue if success
+                if not (success = 0) then
+                    '# now set service.state to running
+                    service->state = Running
+                    
+                    '# now, fire the main loop (onStart)
+                    if not (service->onStart = 0) then
+                        '# create the thread
+                        working_thread = threadcreate(@ServiceProcess.call_onStart, service)
+                    end if
+                    
+                    print "Service is in running state."
+                    print "Press Ctrl-C to stop it."
+                
+                    '# now that onStart is running, must monitor the stop_signal
+                    '# in case it arrives, the service state must change to exit the
+                    '# working thread.
+                    condwait(_svc_stop_signal)
+                    
+                    print "Stop signal received, stopping..."
+                    
+                    '# received the signal, so set state = Stopped
+                    service->state = Stopped
+                    
+                    print "Waiting for onStart() to exit..."
+                    
+                    '# now wait for the thread to terminate
+                    if not (working_thread = 0) then
+                        threadwait(working_thread)
+                    end if
+                    
+                else
+                    print "Error starting the service, onInit() failed."
+                end if
+                
+                print "Service stopped, doing cleanup."
+                
+                '# remove the console handler
+                SetConsoleCtrlHandler(@_console_handler, FALSE)
+                
+                '# now that service was stopped, destroy the references.
+                conddestroy(_svc_stop_signal)
+                
+                print "Done."
+            end if
+        else
+            print "ERROR: No services could be served by this program. Exiting."
+        end if
+        
+        _dprint("ServiceController.Console() done")
+    end sub
+    
+    
+    '# this offer the user a way to test/debug your service or run it like a normal
+    '# program, from the command line
+    '# will let you SHUTDOWN the service using CTRL+C
+    '# use this for single-services
+    sub ServiceController.Console(byref service as ServiceProcess)
+        
+        _dprint("ServiceController.RunMode(service)")
+        
+        '# register the service in the references table
+        _add_to_references(service)
+        
+        _dprint("delegate to Console()")
+        '# now delegate control to Console()
+        this.Console()
+        
+        _dprint("ServiceController.Console(service) done")
+    end sub
+    
+    
+    '# console_handler is used to get feedback form keyboard and allow
+    '# shutdown of service using Ctrl+C / Ctrl+Break from keyboard
+    function _console_handler(byval dwCtrlType as DWORD) as BOOL
+        dim result as BOOL
+        dim service as ServiceProcess ptr
+        
+        _dprint("_console_handler()")
+        
+        '# get the reference from svc_in_console
+        service = _svc_in_console
+        
+        '# we default processing of the message to false
+        result = FALSE
+        
+        '# avoid recursion problems
+        if (_svc_in_console_stop_flag = FALSE) then
+            _dprint("no previous signaled, process event")
+            '# all the CtrlType events listed will raise the onStop
+            '# of the service
+            '# here also will be raised the _svc_stop_signal
+            select case dwCtrlType
+                case CTRL_C_EVENT, CTRL_CLOSE_EVENT, CTRL_BREAK_EVENT, CTRL_LOGOFF_EVENT, CTRL_SHUTDOWN_EVENT:
+                    _dprint("got supported CTRL_*_EVENT")
+                    '# avoid recursion problems
+                    _svc_in_console_stop_flag = TRUE
+                    _dprint("set signaled to TRUE")
+                    
+                    '# the service defined onStop?
+                    if not (service->onStop = 0) then
+                        _dprint("pass control to onStop()")
+                        service->onStop(*service)
+                    end if
+                    
+                    '# now fire the signal
+                    _dprint("fire stop signal")
+                    condsignal(_svc_stop_signal)
+                    result = TRUE
+                    _svc_in_console_stop_flag = FALSE
+                    
+                case else:
+                    _dprint("unsupported CTRL EVENT")
+                    result = FALSE
+            end select
+        else
+            _dprint("already running onStop(), do not pass the message to other message handlers!")
+            result = TRUE
+        end if
+        
+        _dprint("_console_handler() done")
+        return result
+    end function
+    
+    
+    '# helper private subs used to list the services and their descriptions 
+    '# in _svc_references
+    private sub _list_references()
+        dim item as ServiceProcess ptr
+        dim idx as integer
+        
+        print "Available services in this program:"
+        
+        for idx = 0 to (_svc_references_count - 1)
+            item = _svc_references[idx]
+            
+            print space(2);
+            print trim(item->name), , trim(item->description)
+        next idx
+        
+    end sub
+    
+    
+    '# TODO: SimpleLogger
+    '# TODO: EventLogger
+    
+    
+    '#####################
+    '# private (internals)
+    '# _parent_pid is used to retrieve, based on the PID you passed by, the one of the parent
+    '# that launched that process.
+    '# on fail, it will return 0
+    '# Thanks to MichaelW (FreeBASIC forums) for his help about this.
+    private function _parent_pid(byval PID as uinteger) as uinteger
+        dim as uinteger result
+        dim as HANDLE hProcessSnap
+        dim as PROCESSENTRY32 pe32
+        
+        '# initialize result, 0 = fail, other number, ParentPID
+        result = 0
+        
+        hProcessSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
+        if not (hProcessSnap = INVALID_HANDLE_VALUE) then
+            pe32.dwSize = sizeof(PROCESSENTRY32)
+            if (Process32First(hProcessSnap, @pe32) = TRUE) then
+                do
+                    if (pe32.th32ProcessID = PID) then
+                        result = pe32.th32ParentProcessID
+                        exit do
+                    end if
+                loop while not (Process32Next(hProcessSnap, @pe32) = 0)
+            end if
+        end if
+        
+        CloseHandle(hProcessSnap)
+        return result
+    end function
+    
+    
+    '# _process_name is used to retrieve the name (ImageName, BaseModule, whatever) of the PID you
+    '# pass to it. if no module name was found, it should return <unknown>
+    private function _process_name(byval PID as uinteger) as string
+        dim result as string
+        dim hProcess as HANDLE
+        dim hMod as HMODULE
+        dim cbNeeded as DWORD
+        
+        '# assign "<unknown>" to process name, allocate MAX_PATH (260 bytes)
+        result = "<unknown>" 
+        result += space(MAX_PATH - len(result))
+    
+        '# get a handle to the Process
+        hProcess = OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, FALSE, PID)
+        
+        '# if valid, get the process name
+        if not (hProcess = NULL) then
+            '# success getting Process modules
+            if not (EnumProcessModules(hProcess, @hMod, sizeof(hMod), @cbNeeded) = 0) then
+                result = space(cbNeeded)
+                GetModuleBaseName(hProcess, hMod, strptr(result), len(result))
+            end if
+        end if
+        
+        CloseHandle(hProcess)
+        
+        '# return a trimmed result
+        result = trim(result)
+        return result
+    end function
+    
+    '# _process_name_dyn_psapi is a workaround for some issues with x64 versions of Windows.
+    '# by default, 32bits process can't query information from 64bits modules.
+    private function _process_name_dyn_psapi(byval PID as uinteger) as string
+        dim result as string
+        dim chop as uinteger
+        dim zresult as zstring * MAX_PATH
+        dim hLib as any ptr
+        dim hProcess as HANDLE
+        dim cbNeeded as DWORD
+        dim GetProcessImageFileName as function (byval as HANDLE, byval as LPTSTR, byval as DWORD) as DWORD
+      
+        '# assign "<unknown>" to process name, allocate MAX_PATH (260 bytes)
+        zresult = "<unknown>" + chr(0)
+    
+        '# get dynlib
+        hLib = dylibload("psapi.dll")
+        if not (hlib = 0) then
+            GetProcessImageFileName = dylibsymbol(hlib, "GetProcessImageFileNameA")
+            if not (GetProcessImageFileName = 0) then
+                '# get a handle to the Process
+                hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, FALSE, PID)
+                
+                '# if valid, get the process name
+                if not (hProcess = NULL) then
+                    cbNeeded = sizeof(zresult)
+                    if (GetProcessImageFileName(hProcess, @zresult, cbNeeded) = 0) then
+                        _dprint("Error with GetProcessImageFileName")
+                        _dprint("GetLastError: " + str(GetLastError()) + _show_error())
+                    else
+                        result = zresult
+                        chop = InStrRev(0, result, "\")
+                        if (chop > 0) then
+                          result = mid(result, chop + 1, (len(result) - chop))
+                        end if
+                    end if
+                else
+                    _dprint("Error with OpenProcess")
+                    _dprint("GetLastError: " + str(GetLastError()) + _show_error())
+                end if
+                
+                CloseHandle(hProcess)
+            else
+                _dprint("Unable to get a reference to dynamic symbol GetProcessImageFileNameA.")
+            end if
+        else
+            _dprint("Unable to dynamic load psapi.dll")
+        end if
+        
+        '# return a trimmed result
+        'result = trim(result)
+        return result
+    end function
+    
+    private function _show_error() as string
+        dim buffer as string * 1024
+        dim p as integer
+        
+        FormatMessage( FORMAT_MESSAGE_FROM_SYSTEM,_
+                       0,_
+                       GetLastError(),_
+                       0,_
+                       strptr(buffer),_
+                       1024,_
+                       0 )
+        buffer = rtrim(buffer)
+        p = instr(buffer, chr(13))
+        if p then buffer = left(buffer, p - 1)
+        
+        return buffer
+    end function
+    
+    private function InStrRev(byval start as uinteger = 0, byref src as string, byref search as string) as uinteger
+        dim lensearch as uinteger = len(search)
+        dim as uinteger b, a = 0, exit_loop = 0
+        
+        do
+            b = a
+            a += 1
+            a = instr(a, src, search)
+            if start >= lensearch then if a + lensearch > start then exit_loop = 1
+        loop while (a > 0) and (exit_loop = 0)
+        
+        return b
+    end function
+
+end namespace     '# fb.svc.utils
+end namespace     '# fb.svc
+end namespace     '# fb