kotovalexarian-likes-github/puma--puma
1
0
Fork 0
mirror of https://github.com/puma/puma.git synced 2022-11-09 13:48:40 -05:00
Code Releases Activity
puma--puma/projects/mongrel_service/lib/ServiceFB/ServiceFB.bas
luislavena ffa8bd560a mongrel_service: 
* Upgraded to ServiceFB 'trunk' (but pistoned it, just in case).
* Fixed problems with ruby installations outside PATH or inside folders with spaces.
* Activate FB pedantic warnings by default (is really useful).

git-svn-id: svn+ssh://rubyforge.org/var/svn/mongrel/trunk@537 19e92222-5c0b-0410-8929-a290d50e31e9
2007-06-01 22:22:45 +00:00

643 lines
25 KiB
QBasic
Raw Blame History

'#--
'# 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"
namespace fb
namespace svc
'# I started this as simple, unique service served from one process
'# but the idea of share the same process space (and reduce resources use) was good.
'# to do that, I needed a references table (similar to service_table, but we will
'# hold the ServiceProcess registered by ServiceHost (the multi services host).
'# also, I needed a locking mechanism to avoid problems of two calls changing the table
'# at the same time.
dim shared _svc_references as ServiceProcess ptr ptr
dim shared _svc_references_count as integer
dim shared _svc_references_lock as any ptr
'#####################
'# ServiceProcess
'# ctor()
constructor ServiceProcess()
constructor("NewServiceProcess")
end constructor
'# ctor(name)
constructor ServiceProcess(byref new_name as string)
_dprint("ServiceProcess(new_name)")
'# assign the service name
this.name = new_name
'# initialize the status structure
with this._svcStatus
.dwServiceType = SERVICE_WIN32_OWN_PROCESS
.dwCurrentState = SERVICE_STOPPED
.dwControlsAccepted = (SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_SHUTDOWN)
.dwWin32ExitCode = NO_ERROR
.dwServiceSpecificExitCode = NO_ERROR
.dwCheckPoint = 0
.dwWaitHint = 0
end with
'# use a state placeholder
this.state = this._svcStatus.dwCurrentState
'# disable shared process by default
this.shared_process = FALSE
'# create the stop event
this._svcStopEvent = CreateEvent( 0, FALSE, FALSE, 0 )
_dprint("ServiceProcess(new_name) done")
end constructor
'# dtor()
destructor ServiceProcess()
_dprint("ServiceProcess() destructor")
'# safe to destroy it. anyway, just checking
with this
.onInit = 0
.onStart = 0
.onStop = 0
.onPause = 0
.onContinue = 0
._threadHandle = 0
CloseHandle(._svcStopEvent)
end with
_dprint("ServiceProcess() destructor done")
end destructor
'# for single process, here I create the references table and then
'# delegate control to _run() which will call the service control dispatcher
sub ServiceProcess.Run()
_dprint("ServiceProcess.Run()")
'# add the unique reference
_add_to_references(this)
'# delegate control to _run()
_run()
_dprint("ServiceProcess.Run() done")
end sub
'# I use this method to simplify changing the service state
'# notification to the service manager.
'# is needed to set dwControlsAccepted = 0 if state is SERVICE_*_PENDING
'# also, StillAlive() call it to set the checkpoint and waithint
'# to avoid SCM shut us down.
'# is not for the the end-user (*you*) to access it, but implemented in this
'# way to reduce needed to pass the right service reference each time
sub ServiceProcess.UpdateState(byval state as DWORD, byval checkpoint as integer = 0, byval waithint as integer = 0)
_dprint("ServiceProcess.UpdateState()")
'# set the state
select case state
'# if the service is starting or stopping, I must disable the option to accept
'# other controls form SCM.
case SERVICE_START_PENDING, SERVICE_STOP_PENDING:
this._svcStatus.dwControlsAccepted = 0
'# in this case, running or paused, stop and shutdown must be available
'# also, we must check here if our service is capable of pause/continue <20>
'# functionality and allow them (or not).
case SERVICE_RUNNING, SERVICE_PAUSED:
this._svcStatus.dwControlsAccepted = (SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_SHUTDOWN)
'# from start, the service accept stop and shutdown (see ctor(name)).
'# configure the accepted controls.
'# Pause and Continue only will be enabled if you setup onPause and onContinue
if not (this.onPause = 0) and _
not (this.onContinue = 0) then
this._svcStatus.dwControlsAccepted or= SERVICE_ACCEPT_PAUSE_CONTINUE
end if
end select
'# set the structure status
'# also the property
this._svcStatus.dwCurrentState = state
this.state = state
'# set checkpoint and waithint
this._svcStatus.dwCheckPoint = checkpoint
this._svcStatus.dwWaitHint = waithint
'# call the API
'# only we will call is _svcHandle is valid
'# this will allow use of UpdateState (and StillAlive) from console
if not (this._svcHandle = 0) then
_dprint("SetServiceStatus() API")
SetServiceStatus(this._svcHandle, @this._svcStatus)
end if
_dprint("ServiceProcess.UpdateState() done")
end sub
'# use StillAlive() method when performing lengthly tasks during onInit or onStop
'# (if they take too much time).
'# by default we set a wait hint gap of 10 seconds, but you could specify how many
'# you could specify how many seconds more will require your *work*
sub ServiceProcess.StillAlive(byval waithint as integer = 10)
dim as integer checkpoint
_dprint("ServiceProcess.StillAlive()")
'# start or stop pending?
if (this._svcStatus.dwCurrentState = SERVICE_START_PENDING) or _
(this._svcStatus.dwCurrentState = SERVICE_STOP_PENDING) then
with this
checkpoint = this._svcStatus.dwCheckPoint
checkpoint += 1
.UpdateState(._svcStatus.dwCurrentState, checkpoint, (waithint * 1000))
end with
end if
_dprint("ServiceProcess.StillAlive() done")
end sub
'#####################
'# ServiceHost
'# ctor()
'# currently isn't needed, why I defined it?
constructor ServiceHost()
_dprint("ServiceHost()")
_dprint("ServiceHost() done")
end constructor
'# dtor()
'# currently isn't needed, why I defined it?
destructor ServiceHost()
_dprint("ServiceHost() destructor")
_dprint("ServiceHost() destructor done")
end destructor
'# using Add() will register an already initialized service into the references
'# table, which will be used later to launch and control the different services
'# we should be careful when handling references, so for that reference_lock is
'# provided ;-)
sub ServiceHost.Add(byref service as ServiceProcess)
_dprint("ServiceHost.Add()")
'# add the service reference to the references table
'# get the new count as result, so
'# increment the local counter
this.count = _add_to_references(service)
_dprint("ServiceHost.Add() done")
end sub
'# ServiceHost.Run() is just a placeholder, it delegates control to _run()
'# pretty simple, but still must be present to simplify user interaction.
sub ServiceHost.Run()
_dprint("ServiceHost.Run()")
'# the longest, hard coded function in the world!
'# just kidding
_run()
_dprint("ServiceHost.Run() done")
end sub
'# the purpose of this sub is provide a generic service creation and running
'# this is be called from exisitng ServiceProcess and ServiceHost.
'# this construct the SERVICE_TABLE_ENTRY based on the the references table,
'# which will be sent to StartServiceCtrlDispatcher()
private sub _run()
dim ServiceTable(_svc_references_count) as SERVICE_TABLE_ENTRY
dim idx as integer
_dprint("_run()")
_dprint("creating service table for " + str(_svc_references_count) + " services")
for idx = 0 to (_svc_references_count - 1)
'# we take the service name from the references and set as ServiceMain the same
'# _main() routine for all the services
ServiceTable(idx) = type<SERVICE_TABLE_ENTRY>(strptr(_svc_references[idx]->name), @_main)
_dprint(str(idx) + ": " + _svc_references[idx]->name)
next idx
'# last member of the table must be null
ServiceTable(_svc_references_count) = type<SERVICE_TABLE_ENTRY>(0, 0)
_dprint("service table created")
'# start the dispatcher
_dprint("start service dispatcher")
StartServiceCtrlDispatcher( @ServiceTable(0) )
_dprint("_run() done")
end sub
'# this sub is fired by StartServiceCtrlDispatcher in another thread.
'# because it is a global _main for all the services in the table, looking up
'# in the references for the right service is needed prior registering its
'# control handler.
private sub _main(byval argc as DWORD, byval argv as LPSTR ptr)
dim success as integer
dim service as ServiceProcess ptr
dim run_mode as string
dim service_name as string
dim commandline as string
dim param_line as string
dim temp as string
_dprint("_main()")
'# debug dump of argc and argv
dim idx as integer = 0
for idx = 0 to (argc - 1)
_dprint(str(idx) + ": " + *argv[idx])
next idx
'# retrieve all the information (mode, service name and command line
_build_commandline(run_mode, service_name, commandline)
service = _find_in_references(service_name)
'# build parameter line (passed from SCM)
if (argc > 1) then
param_line = ""
for idx = 1 to (argc - 1)
temp = *argv[idx]
if (instr(temp, chr(32)) > 0) then
param_line += """" + temp + """"
else
param_line += temp
end if
param_line += " "
next idx
end if
'# parameters passed using SCM have priority over ImagePath ones
if not (len(param_line) = 0) then
commandline = param_line
end if
'# a philosofical question: to run or not to run?
if not (service = 0) then
_dprint("got a valid service reference")
_dprint("real service name: " + service->name)
'# pass to the service the commandline
_dprint("passing service commandline: " + commandline)
service->commandline = commandline
'# ok, its a service!, its alive!
'# register his ControlHandlerEx
_dprint("register control handler ex")
service->_svcHandle = RegisterServiceCtrlHandlerEx(strptr(service_name), @_control_ex, cast(LPVOID, service))
'# check if evething is done right
if not (service->_svcHandle = 0) then
'# now, we are a single service or a bunch, like the bradys?
if (_svc_references_count > 1) then
'# determine if we share or not the process
if (service->shared_process = FALSE) then
service->_svcStatus.dwServiceType = SERVICE_WIN32_OWN_PROCESS
else
'# this mean we will be sharing... hope neighbors don't crash the house!
service->_svcStatus.dwServiceType = SERVICE_WIN32_SHARE_PROCESS
end if
else
'# ok, we have a full house (ehem, process) for us only!
service->_svcStatus.dwServiceType = SERVICE_WIN32_OWN_PROCESS
end if
'# START_PENDING
_dprint("service start pending")
service->UpdateState(SERVICE_START_PENDING)
'# now delegate to the long running initialization if it exist.
if not (service->onInit = 0) then
_dprint("pass control to lengthly initialization")
success = service->onInit(*service)
else
'# if no onInit was defined (maybe you don't need it?)
'# we should simulate it was successful to proceed
success = (-1)
end if
_dprint("onInit result: " + str(success))
'# check if everything is ok
'# if onInit showed problems, 0 was returned and service must not continue
if not (success = 0) then
'# SERVICE_RUNNING
'# we must launch the onStart as thread, but first setting state as running
service->UpdateState(SERVICE_RUNNING)
if not (service->onStart = 0) then
_dprint("dispatch onStart() as new thread")
service->_threadHandle = threadcreate(service->onStart, service)
'# my guess? was a hit!
end if
'# now that we are out of onStart thread, check if actually hit the stop sign
_dprint("waiting for stop signal")
do
'# do nothing ...
'# but not too often!
loop while (WaitForSingleObject(service->_svcStopEvent, 100) = WAIT_TIMEOUT)
'# now, wait for the thread (anyway, I hope it will be checking this.state, right?)
'# we should do this, or actualy jump and wait for StopEvent?
_dprint("waiting for onStart() thread to finish")
threadwait(service->_threadHandle)
end if
'# if we reach here, that means the service is not running, and the onStop was performed
'# so no more chat, stop it one and for all!
'# set SERVICE_STOPPED (just checking)
_dprint("service stopped")
service->UpdateState(SERVICE_STOPPED)
end if
'# ok, we are done!
end if
_dprint("_main() done")
end sub
'# this sub is used by _main when registering the ControlHandler for this service
'# (as callback from service manager).
'# we process each control codes and perform the actions using the pseudo-events (callbacks)
'# also we use lpContext to get the right reference when _main registered the control handler.
private function _control_ex(byval dwControl as DWORD, byval dwEventType as DWORD, byval lpEventData as LPVOID, byval lpContext as LPVOID) as DWORD
dim result as DWORD
dim service as ServiceProcess ptr
_dprint("_control_ex()")
'# we get a reference form the context
service = cast(ServiceProcess ptr, lpContext)
'# show if the service reference is valid?
_dprint("service name: " + service->name)
select case dwControl
case SERVICE_CONTROL_INTERROGATE:
'# we are running, so what we should do here?
_dprint("interrogation signal received")
'# in case we get a interrogation, we always should answer this way.
result = NO_ERROR
case SERVICE_CONTROL_SHUTDOWN, SERVICE_CONTROL_STOP:
_dprint("stop signal received")
'# ok, service manager requested us to stop.
'# we must call onStop if was defined.
service->UpdateState(SERVICE_STOP_PENDING)
if not (service->onStop = 0) then
_dprint("pass control to onStop()")
service->onStop(*service)
end if
'# now signal the stop event so _main could take care of the rest.
_dprint("signal stop event")
SetEvent(service->_svcStopEvent)
case SERVICE_CONTROL_PAUSE:
_dprint("pause signal received")
'# we must check if we could answer to the request.
if not (service->onPause = 0) and _
not (service->onContinue = 0) then
'# just to be sure
if not (service->onPause = 0) then
service->UpdateState(SERVICE_PAUSE_PENDING)
_dprint("pass control to onPause()")
service->onPause(*service)
service->UpdateState(SERVICE_PAUSED)
_dprint("service paused")
end if
result = NO_ERROR
else
'# ok, our service didn't support pause or continue
'# tell the service manager about that!
result = ERROR_CALL_NOT_IMPLEMENTED
end if
case SERVICE_CONTROL_CONTINUE:
_dprint("continue signal received")
'# we should resume from a paused state
'# we must check if we could answer to the request.
if not (service->onPause = 0) and _
not (service->onContinue = 0) then
'# just to be sure
if not (service->onPause = 0) then
service->UpdateState(SERVICE_CONTINUE_PENDING)
_dprint("pass control to onContinue()")
service->onContinue(*service)
service->UpdateState(SERVICE_RUNNING)
_dprint("service running")
end if
result = NO_ERROR
else
'# ok, our service didn't support pause or continue
'# tell the service manager about that!
result = ERROR_CALL_NOT_IMPLEMENTED
end if
case else:
result = NO_ERROR
end select
_dprint("_control_ex() done")
return result
end function
'# add_to_references is a helper used to reduce code duplication (DRY).
'# here is used a lock around _svc_references to avoid two threads try change the
'# reference count (just in case).
function _add_to_references(byref service as ServiceProcess) as integer
_dprint("_add_to_references()")
'# get a lock before even think touch references!
mutexlock(_svc_references_lock)
'# now, reallocate space
_svc_references_count += 1
_svc_references = reallocate(_svc_references, sizeof(ServiceProcess ptr) * _svc_references_count)
'# put the reference of this service into the table
_svc_references[(_svc_references_count - 1)] = @service
'# ok, done, unlock our weapons! ;-)
mutexunlock(_svc_references_lock)
_dprint("_add_to_references() done")
'# return the new references count
return _svc_references_count
end function
'# find_in_references is used by _main to lookup for the specified service in
'# references table.
function _find_in_references(byref service_name as string) as ServiceProcess ptr
dim result as ServiceProcess ptr
dim item as ServiceProcess ptr
dim idx as integer
_dprint("_find_in_references()")
'# we start with a pesimistic idea ;-)
result = 0
for idx = 0 to (_svc_references_count - 1)
'# hold a reference to the item
item = _svc_references[idx]
'# compare if we have a match
if (service_name = item->name) then
result = item
exit for
end if
next idx
_dprint("_find_in_references() done")
'# return the found (or not) reference
return result
end function
'# namespace constructor
'# first we must create the mutex to be used with references
private sub _initialize() constructor
_dprint("_initialize() constructor")
'# we do this in case was already defined... don't know the situation,
'# just to be sure
if (_svc_references_lock = 0) then
_svc_references_lock = mutexcreate()
'# also initialize our count :-)
_svc_references_count = 0
end if
_dprint("_initialize() constructor done")
end sub
'# namespace destructor
private sub _terminate() destructor
_dprint("_terminate() destructor")
'# to avoid removing everything, we must lock to the references
mutexlock(_svc_references_lock)
'# destroy our refernces allocated memory!
deallocate(_svc_references)
'# unlock the mutex and destroy it too.
mutexunlock(_svc_references_lock)
mutexdestroy(_svc_references_lock)
_dprint("_terminate() destructor done")
end sub
'# command line builder (helper)
'# this is used to gather information about:
'# mode (if present)
'# valid service name (after lookup in the table)
'# command line to be passed to service
sub _build_commandline(byref mode as string, byref service_name as string, byref commandline as string)
dim result_mode as string
dim result_name as string
dim result_cmdline as string
dim service as ServiceProcess ptr
dim idx as integer
dim temp as string
idx = 1
'# first, determine if mode is pressent in commandline, must me command(1)
temp = lcase(command(idx))
if (temp = "console") or _
(temp = "manage") then
result_mode = temp
idx += 1
end if
'# now, check if service name is present
temp = command(idx)
'# its present?
if (len(temp) > 0) then
'# lookup in references table
service = _find_in_references(temp)
if not (service = 0) then
'# was found, so must be valid
result_name = temp
'# adjust start index for cmdline
idx += 1
end if
end if
'# is service valid?
'# its really needed?
if (service = 0) then
if (_svc_references_count = 1) then
'# no, get the first one
service = _svc_references[0]
result_name = service->name
'# adjust start index for cmdline
else
'# this is needed!
result_name = ""
end if
end if
result_cmdline = ""
temp = command(idx)
do while (len(temp) > 0)
if (instr(temp, chr(32)) > 0) then
'# properly quote parameters with spaces
result_cmdline += """" + temp + """"
else
result_cmdline += temp
end if
result_cmdline += " "
idx += 1
temp = command(idx)
loop
'# now, return the results
mode = result_mode
service_name = result_name
commandline = result_cmdline
end sub
'# ### DEBUG ###
'# just for debuging purposes
'# (will be removed in the future when Loggers get implemented)
#ifdef SERVICEFB_DEBUG_LOG
sub _dprint(byref message as string)
dim handle as integer
handle = freefile
open EXEPATH + "\servicefb.log" for append as #handle
print #handle, message
close #handle
end sub
#endif
end namespace '# fb.svc
end namespace '# fb
View git blame Copy permalink