# ------------------------------------------------------------ # Copyright (c) 2014-2018 # Q.W.Page Associates Inc. # www.qwpage.com # All rights reserved. # ------------------------------------------------------------ ::if {$::qw::control(process_file_is_enabled)} { /* { 2.34.4 We replaced services with a process_file and I would like to throw a bug here. But the fact remains we may need some of this functionality when updating 2.33 or earlier to 2.34 or later because we may have to kill running services. Note: one could ask if we can get a process_id for 2.33 services and somply kill them. */ } #::qw::bug 314120181129160457 "qw_service_utils is not used when process_file_is_enabled."; } ::if {$::qw::control(process_file_is_enabled)} { # ::return; } ::namespace eval ::qw::service_utils {}; ::switch -- $::tcl_platform(platform) { "windows" { # ::qw::packages::package_require_twapi; } "unix" { ::package require Tclx; # ------------------------------------------------------------ # ::qw::service_utils::linux_process_file # ------------------------------------------------------------ /* { We generally refer to this file as the service_process_file. It is a sargs file where each (named) record represents a running "service". We are simulating windows services here because we can't get daemons working and because we don't have the equivalent of the windows service manager. We need a place where we can get a list of running services. Note that this library should be the only place that refers to the service_process_file. */ } ::set ::qw::service_utils::linux_process_file [::file join $::qw_program_folder service_process_list.txt]; } } ::proc ::qw::service_utils::newviews_service_count {} { /* { How many newviews services are running? nv2_install.qw_script and auto_upgrade need to know if it is necessary to stop the services and/or run as administrator. */ } ::switch -- $::tcl_platform(platform) { "windows" { /* { We get the list of service names for services containing 314120160407135741. We use that (arbitrary) unique number in the description of all newviews service_hubs and service_nodes in order to easily identify them. */ } ::set Result [::qw::service_utils::314120160407135741_list_get]; ::set ServiceHubNameList [::sargs::get $Result .service_hub_name_list]; ::set ServiceNodeNameList [::sargs::get $Result .service_node_name_list]; ::set Count 0; ::incr Count [::llength $ServiceHubNameList]; ::incr Count [::llength $ServiceNodeNameList]; ::if {[::twapi::service_exists "NewViewsServer"]} { /* { Legacy alert: NewViewsServer was the name we used by default for pre-2.29 services. So a service with the name NewViewsServer may exist without 314120160407135741 in the command options. If so, then we must increase the count. A 2.29.0 service will probably have the same name because we kwept the same default in 2.29. So if the service_hub name list contains NewViewsServer, do nothing. Note that there is no need to search the service_node list. */ } ::if {[::lsearch $ServiceHubNameList "NewViewsServer"]<0} { ::incr Count 1; ::return $Count; } } ::return $Count; } "unix" { ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,newviews_service_count,1000.00";} ::set RecordList [::sargs::file::get $::qw::service_utils::linux_process_file]; ::set Count 0; ::foreach {Name Record} $RecordList { ::if {$rwb1_debug} {::puts "rwb1_debug,newviews_service_count,1000.01";} ::if {[process_is_running $Record]} { ::if {$rwb1_debug} {::puts "rwb1_debug,newviews_service_count,1000.02";} ::incr Count; } else { /* { Might as well eliminate dangling records from the service_process_file. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,newviews_service_count,1000.03,eliminating orphan,record==\n[::sargs::format $Record]";} ::sargs::file::unset $::qw::service_utils::linux_process_file $Name; } } ::if {$rwb1_debug} {::puts "rwb1_debug,newviews_service_count,1000.99,count==$Count";} ::return $Count; } } } ::proc ::qw::service_utils::is_run_as_administrator {} { /* { Returns 1 if running as administrator. */ } ::switch -- $::tcl_platform(platform) { "windows" { /* { If we try to create a service (with a random name) and that fails, we can assume we are not the administrator. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::is_run_as_administrator,1000.0";} ::set ServiceName "314120160516144624"; # ::set ServiceName "314120160516144624_[::clock seconds]"; ::set Commandline "314120160516144624.exe"; ::set ServiceDisplayName "314120160516144624 display name"; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::is_run_as_administrator,1000.1";} ::if {[::twapi::service_exists $ServiceName]} { /* { During testing, when errors were occurring, we left this service behind and it resulted in subsequent problems the next time we ran nv2_install.qw_script. */ } ::qw::try { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::is_run_as_administrator,1000.1.0";} ::twapi::delete_service $ServiceName; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::is_run_as_administrator,1000.1.1";} } catch Exception { ::if {[::string first "access is denied" [::string tolower $Exception]]>=0} { ::return 0; } ::qw::warning 314120160704153635 "[::namespace current]::[::qw::procname] - could not delete service $ServiceName,Exception==$Exception"; ::return 0; } ::return 1; } ::qw::try { ::if {$rwb1_debug} {::puts "rwb1_debug,1000.2.0,ServiceName==$ServiceName";} ::if {$rwb1_debug} {::puts "rwb1_debug,1000.2.1,Commandline==$Commandline";} ::twapi::create_service \ $ServiceName \ $Commandline \ -displayname $ServiceDisplayName \ -starttype demand_start \ -servicetype "win32_own_process" \ -interactive 0 \ -errorcontrol "normal" \ ; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::is_run_as_administrator,1000.3";} } catch Exception { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::is_run_as_administrator,1000.4,Exception==$Exception";} ::if {[::string first "access is denied" [::string tolower $Exception]]>=0} { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::is_run_as_administrator,1000.5";} ::return 0; } ::qw::throw "Encountered a problem in is_run_as_administrator command, exception==$Exception."; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::is_run_as_administrator,1000.6";} ::qw::service_utils::service_destroy .service_name $ServiceName; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::is_run_as_administrator,1000.7";} ::return 1; } "unix" { /* { On linux we will assume we are the administrator. I believe we will need to refine this concept and run as sudo. */ } ::return 1; } } } ::proc ::qw::service_utils::service_destroy_all {sargs} { ::switch -- $::tcl_platform(platform) { "windows" { /* { Destroy all nodes and then all hubs. Used by nv2_install.qw_script and windows_service_manager.qw_script. Note ::qw::control(servie_file_is_enabled) This will not longer be used as a blint instrument. In the future we will destroy one hub and its nodes. We used to destroy a service_hub and let it in turn destroy its service_nodes. But there was typically a dangling service_node when we did this. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,service_node_garbage_collect,1000.0";} ::set Result [::qw::service_utils::314120160407135741_list_get]; ::set ServiceHubNameList [::sargs::get $Result .service_hub_name_list]; ::set ServiceNodeNameList [::sargs::get $Result .service_node_name_list]; ::if {$rwb1_debug} {::puts "rwb1_debug,service_node_garbage_collect,1000.4,ServiceNodeNameList==$ServiceNodeNameList";} ::set OrphanList [::list]; ::foreach ServiceName $ServiceNodeNameList { /* { Loop through the service_node services and determine if any of them are orphans because we can't find their (running) service_hub. */ } ::qw::try { service_destroy .service_name $ServiceName; } catch Exception { ::qw::warning 314120180621082028 "[::namespace current]::[::qw::procname] - could not destroy service $ServiceName,Exception==$Exception"; } } ::foreach ServiceName $ServiceHubNameList { /* { Loop through the service_node services and determine if any of them are orphans because we can't find their (running) service_hub. */ } ::qw::try { service_destroy .service_name $ServiceName; } catch Exception { ::qw::warning 31412018062108202 "[::namespace current]::[::qw::procname] - could not destroy service $ServiceName,Exception==$Exception"; } } } "unix" { } } } ::proc ::qw::service_utils::service_destroy {sargs} { /* { Deletes a service if possible but throws no exceptions. */ } ::switch -- $::tcl_platform(platform) { "windows" { /* { 2.32.3 We used to call ::twapi::stop_service when the state was "running". Now we just call ::twapi::delete_service. When we called stop_service it could leave an idle service in the "stopped" state and the call didn't return at all unless -wait was used. In any case, you had to run the wsi script to get rid of the service. */ } ::set rwb1_debug 0; ::set ServiceName [::sargs::get $sargs .service_name]; ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.0,ServiceName==$ServiceName";} ::if {$ServiceName eq ""} { ::qw::bug 314120160404171421 "[::namespace current]::[::qw::procname] - no .service_name argument."; } ::if {![::twapi::service_exists $ServiceName]} { ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.0.0";} ::return; } ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.1,ServiceName==$ServiceName";} # this was eliminated in 2.32.3 - see comment above ::set State [::twapi::get_service_state $ServiceName]; ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.2,State==$State";} ::set ServiceStopSkip [::sargs::boolean_get $sargs .service_stop_skip]; ::if {$State eq "running"&&!$ServiceStopSkip} { ::qw::try { /* { 2.32.3 This call to stop the service_node seems to stop the service_node ok it hangs and does not continue in order to shutdown the service_node. So the service_node sits there stopped. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.3,clock seconds==[::clock seconds]";} # ::twapi::stop_service $ServiceName; ::twapi::stop_service $ServiceName -wait 30000; ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.4,clock seconds==[::clock seconds]";} } catch Dummy { ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.4.0,Dummy==$Dummy";} ::qw::warning 314120160404171617 "[::namespace current]::[::qw::procname] - could not stop service $ServiceName,Dummy==$Dummy"; } } ::qw::try { ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.5";} ::twapi::delete_service $ServiceName; ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.6";} } catch Exception { ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.7,Exception==$Exception";} ::qw::warning 314120160404171616 "[::namespace current]::[::qw::procname] - could not delete service $ServiceName,Exception==$Exception"; } ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.8";} } "unix" { ::set rwb1_debug 0; ::set ServiceName [::sargs::get $sargs .service_name]; ::if {$rwb1_debug} {::puts "rwb1_debug,service_destroy,1000.00,ServiceName==$ServiceName";} ::if {$ServiceName eq ""} { ::qw::bug 314120180326141243 "[::namespace current]::[::qw::procname] - no .service_name argument."; } ::set RecordList [::sargs::file::get $::qw::service_utils::linux_process_file]; ::foreach {Name Record} $RecordList { ::if {[::sargs::get $Record .service_name] eq $ServiceName} { ::if {[process_is_running $Record]} { ::if {$rwb1_debug} {::puts "rwb1_debug,service_destroy,1000.01,ServiceName==$ServiceName";} ::set ProcessId [::sargs::get $Record .process_id]; ::if {$ProcessId eq ""} { ::qw::bug 314120180326144253 "[::namespace current]::[::qw::procname] - no .process_id."; } ::kill SIGTERM $ProcessId; } } } ::if {$rwb1_debug} {::puts "rwb1_debug,service_destroy,1000.04,ServiceName==$ServiceName";} } } } ::proc ::qw::service_utils::service_exists {sargs} { /* { Deletes a service if possible but throws no exceptions. */ } ::switch -- $::tcl_platform(platform) { "windows" { /* { 2.32.3 We used to call ::twapi::stop_service when the state was "running". Now we just call ::twapi::delete_service. When we called stop_service it could leave an idle service in the "stopped" state and the call didn't return at all unless -wait was used. In any case, you had to run the wsi script to get rid of the service. */ } ::set rwb1_debug 0; ::set ServiceName [::sargs::get $sargs .service_name]; ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.0,ServiceName==$ServiceName";} ::if {$ServiceName eq ""} { ::qw::bug 314120160404171421 "[::namespace current]::[::qw::procname] - no .service_name argument."; } ::if {![::twapi::service_exists $ServiceName]} { ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.0.0";} ::return; } ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.1,ServiceName==$ServiceName";} # this was eliminated in 2.32.3 - see comment above ::set State [::twapi::get_service_state $ServiceName]; ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.2,State==$State";} ::set ServiceStopSkip [::sargs::boolean_get $sargs .service_stop_skip]; ::if {$State eq "running"&&!$ServiceStopSkip} { ::qw::try { /* { 2.32.3 This call to stop the service_node seems to stop the service_node ok it hangs and does not continue in order to shutdown the service_node. So the service_node sits there stopped. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.3,clock seconds==[::clock seconds]";} # ::twapi::stop_service $ServiceName; ::twapi::stop_service $ServiceName -wait 30000; ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.4,clock seconds==[::clock seconds]";} } catch Dummy { ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.4.0,Dummy==$Dummy";} ::qw::warning 314120160404171617 "[::namespace current]::[::qw::procname] - could not stop service $ServiceName,Dummy==$Dummy"; } } ::qw::try { ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.5";} ::twapi::delete_service $ServiceName; ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.6";} } catch Exception { ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.7,Exception==$Exception";} ::qw::warning 314120160404171616 "[::namespace current]::[::qw::procname] - could not delete service $ServiceName,Exception==$Exception"; } ::if {$rwb1_debug} {::puts "rwb1_debug,qw::service_utils::service_destroy,1000.8";} } "unix" { ::set rwb1_debug 0; ::set ServiceName [::sargs::get $sargs .service_name]; ::if {$rwb1_debug} {::puts "rwb1_debug,service_destroy,1000.00,ServiceName==$ServiceName";} ::if {$ServiceName eq ""} { ::qw::bug 314120180326141243 "[::namespace current]::[::qw::procname] - no .service_name argument."; } ::set RecordList [::sargs::file::get $::qw::service_utils::linux_process_file]; ::foreach {Name Record} $RecordList { ::if {[::sargs::get $Record .service_name] eq $ServiceName} { ::if {[process_is_running $Record]} { ::if {$rwb1_debug} {::puts "rwb1_debug,service_destroy,1000.01,ServiceName==$ServiceName";} ::set ProcessId [::sargs::get $Record .process_id]; ::if {$ProcessId eq ""} { ::qw::bug 314120180326144253 "[::namespace current]::[::qw::procname] - no .process_id."; } ::kill SIGTERM $ProcessId; } } } ::if {$rwb1_debug} {::puts "rwb1_debug,service_destroy,1000.04,ServiceName==$ServiceName";} } } } ::proc ::qw::service_utils::find_process_id {sargs} { # don't think this is used ::switch -- $::tcl_platform(platform) { "windows" { ::qw::bug 314120180424141559 "[::namespace current]::[::qw::procname] - this method can only be used on linux."; } "unix" { } } ::set ServiceAppName [::sargs::get $sargs .service_app_name]; ::switch -- $ServiceAppName { "app_name_service_hub" { ::set RecordList [::sargs::file::get $::qw::service_utils::linux_process_file]; ::foreach {Name Record} $RecordList { ::if {[::sargs::get $Record .service_app_name] eq $ServiceAppName} { ::return [::sargs::get $Record .process_id]; } } } default { ::qw::bug 314120180424141558 "[::namespace current]::[::qw::procname] - no .service_app_name argument."; } } } ::proc ::qw::service_utils::kill_linux_service_hub {sargs} { /* { Hard-wired to kill the linux service hub, which should also kill the nodes. But just in case, we garbage collect. Again note that we can have only one service_hub running out of a program folder in linux. The ability to run mulitple services in windows was overkill. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,kill_linux_service_hub,1000.00";} ::switch -- $::tcl_platform(platform) { "windows" { ::qw::bug 314120180425100222 "[::namespace current]::[::qw::procname] - this method can only be used on linux."; } "unix" { } } ::set RecordList [::sargs::file::get $::qw::service_utils::linux_process_file]; ::foreach {Name Record} $RecordList { ::if {[::sargs::get $Record .service_app_name] eq "app_name_service_hub"} { ::if {$rwb1_debug} {::puts "rwb1_debug,kill_linux_service_hub,1000.01";} ::set ProcessId [::sargs::integer_get $Record .process_id]; ::if {[process_is_running .process_id $ProcessId]} { ::qw::try { ::if {$rwb1_debug} {::puts "rwb1_debug,kill_linux_service_hub,1000.02";} ::kill SIGTERM $ProcessId; ::if {$rwb1_debug} {::puts "rwb1_debug,kill_linux_service_hub,1000.03";} } catch dummy { ::if {$rwb1_debug} {::puts "rwb1_debug,kill_linux_service_hub,1000.04";} } } } } ::if {$rwb1_debug} {::puts "rwb1_debug,kill_linux_service_hub,1000.05";} service_node_garbage_collect; ::if {$rwb1_debug} {::puts "rwb1_debug,kill_linux_service_hub,1000.06";} } ::proc ::qw::service_utils::314120160407135741_list_get {} { /* { Gets a lists of all newviews services. returns { .service_hub_name_list {} .service_node_name_list {} } */ } ::switch -- $::tcl_platform(platform) { "windows" { } "unix" { ::qw::bug "314120180329080555" "[::namespace current]::[::qw::procname] - Can't call this method in linux."; } } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,314120160407135741_service_list_get,1000.0";} ::set List [::twapi::get_multiple_service_status \ -win32_own_process \ -win32_share_process \ ]; /* { The twapi 8.4 and 8.6 implementations returns differently formatted results from the above call to get_multiple_service_status. */ } ::switch -- $::tcl_version { 8.4 { /* { The List is in the form of name/value pairs. */ } ::set ServiceList $List; ::if {$rwb1_debug} {::puts "rwb1_debug,314120160407135741_service_list_get,1000.1,ServiceList==$ServiceList";} # ::set FieldNameList [::lindex $List 0]; # ::set ServiceList [::lindex $List 1]; # ::set NameIndex [::lsearch -exact $FieldNameList "name"]; ::set ServiceHubNameList [::list]; ::set ServiceNodeNameList [::list]; # ::if {$rwb1_debug} {::puts "rwb1_debug,314120160407135741_service_list_get,1000.1.0,NameIndex==$NameIndex";} ::foreach Service $ServiceList { ::if {$rwb1_debug} {::puts "rwb1_debug,314120160407135741_service_list_get,1000.1.1,Service==$Service";} ::array set ServiceArray $Service; # ::set ServiceName [::lindex $Service $NameIndex]; ::set ServiceName $ServiceArray(name); ::if {$rwb1_debug} {::puts "rwb1_debug,314120160407135741_service_list_get,1000.1.1.0,ServiceName==$ServiceName";} ::set Commandline [::lindex [::twapi::get_service_configuration $ServiceName -command] 1]; ::if {$rwb1_debug} {::puts "rwb1_debug,314120160407135741_service_list_get,1000.1.1.1,Commandline==$Commandline";} ::set Index [::lsearch -exact $Commandline "-314120160407135741"]; ::if {$Index<0} { ::if {$rwb1_debug} {::puts "rwb1_debug,314120160407135741_service_list_get,1000.1.2";} ::continue; } ::if {$rwb1_debug} {::puts "rwb1_debug,314120160407135741_service_list_get,1000.1.3";} ::incr Index; ::switch -exact [::lindex $Commandline $Index] { service_node { ::if {$rwb1_debug} {::puts "rwb1_debug,314120160407135741_service_list_get,1000.2";} ::lappend ServiceNodeNameList $ServiceName; } service_hub { ::if {$rwb1_debug} {::puts "rwb1_debug,314120160407135741_service_list_get,1000.3";} ::lappend ServiceHubNameList $ServiceName; } default { ::qw::bug 314120160620163423 "[::qw::procname] - invalid value \"[::lindex $Commandline $Index]\"." } } } ::return [::sargs \ .service_hub_name_list $ServiceHubNameList \ .service_node_name_list $ServiceNodeNameList \ ]; } 8.6 - default { /* { The List is in the form of {name_list {{entry list} {entry list} ...}} name/value pairs. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,314120160407135741_service_list_get,2000.0";} ::set ResultList [::sargs]; ::set List [::twapi::get_multiple_service_status \ -win32_own_process \ -win32_share_process \ ]; ::if {$rwb1_debug} {::puts "rwb1_debug,314120160407135741_service_list_get,2000.1";} ::set FieldNameList [::lindex $List 0]; ::set ServiceList [::lindex $List 1]; ::set NameIndex [::lsearch -exact $FieldNameList "name"]; ::set ServiceHubNameList [::list]; ::set ServiceNodeNameList [::list]; ::if {$rwb1_debug} {::puts "rwb1_debug,314120160407135741_service_list_get,2000.1.0,NameIndex==$NameIndex";} ::foreach Service $ServiceList { ::if {$rwb1_debug} {::puts "rwb1_debug,314120160407135741_service_list_get,2000.1.1,Service==$Service";} ::set ServiceName [::lindex $Service $NameIndex]; ::if {$rwb1_debug} {::puts "rwb1_debug,314120160407135741_service_list_get,2000.1.1.0,ServiceName==$ServiceName";} ::set Commandline [::lindex [::twapi::get_service_configuration $ServiceName -command] 1]; ::if {$rwb1_debug} {::puts "rwb1_debug,314120160407135741_service_list_get,2000.1.1.1,Commandline==$Commandline";} ::set Index [::lsearch -exact $Commandline "-314120160407135741"]; ::if {$Index<0} { ::if {$rwb1_debug} {::puts "rwb1_debug,314120160407135741_service_list_get,2000.1.2";} ::continue; } ::if {$rwb1_debug} {::puts "rwb1_debug,314120160407135741_service_list_get,2000.1.3";} ::incr Index; ::switch -exact [::lindex $Commandline $Index] { service_node { ::if {$rwb1_debug} {::puts "rwb1_debug,314120160407135741_service_list_get,2000.2";} ::lappend ServiceNodeNameList $ServiceName; } service_hub { ::if {$rwb1_debug} {::puts "rwb1_debug,314120160407135741_service_list_get,2000.3";} ::lappend ServiceHubNameList $ServiceName; } } } ::return [::sargs \ .service_hub_name_list $ServiceHubNameList \ .service_node_name_list $ServiceNodeNameList \ ]; } } } ::proc ::qw::service_utils::service_structure_list {sargs} { ::set rwb1_debug 0; ::switch -- $::tcl_platform(platform) { "windows" { ::set Select [::sargs::get $sargs .select]; ::switch -- $Select { nodes { ::set Result [::qw::service_utils::314120160407135741_list_get]; ::set ServiceNameList [::sargs::get $Result .service_node_name_list]; } hubs { ::set Result [::qw::service_utils::314120160407135741_list_get]; ::set ServiceNameList [::sargs::get $Result .service_hub_name_list]; } "" { ::set Result [::qw::service_utils::314120160407135741_list_get]; ::set ServiceNameList [::concat [::sargs::get $Result .service_hub_name_list] [::sargs::get $Result .service_node_name_list]]; } default { ::qw::throw \ .text "[::qw::procname] - Invalid .select value \"$Select\"." \ .error_id 314120220201153406 \ ; } } ::set ServiceStructureList [::sargs]; ::set Count 0; ::foreach ServiceName $ServiceNameList { ::set Service [::twapi::get_service_configuration $ServiceName -command]; ::set Commandline [::lindex $Service 1]; ::set ServiceData [::eval ::sargs::hyphen_to_dot [::lrange $Commandline 1 end]]; ::sargs::var::set ServiceStructureList .$Count $ServiceData; ::incr Count 1; } ::return $ServiceStructureList; } "unix" { } } /* { .0 { .run_as_service NewViewsServer .database_path d:/db_235/server.nv2 .service_hub_id 16437447686208 .314120160407135741 service_hub .script system/service/qw_service_hub.qw_script } .1 { .service_hub_id 16437447686208 .service_hub_port_number 9000 .service_hub_hostname benn7 .service_node_id newviews_node_6208_0 .run_as_service newviews_node_6208_0 .314120160407135741 service_node .script system/service/qw_service_node.qw_script .service_hub_process_id 6208 } .2 { .service_hub_id 16437447686208 .service_hub_port_number 9000 .service_hub_hostname benn7 .service_node_id newviews_node_6208_1 .run_as_service newviews_node_6208_1 .314120160407135741 service_node .script system/service/qw_service_node.qw_script .service_hub_process_id 6208 } */ } ::qw::service_utils::debug_structure_get; ::qw::dialog3::notify .text "test_qw_service_utils_debug_structure_get completed."; ::if {[::sargs::find_field_value .structure $sargs .field .invoker .value commandline]} { ::puts "qw::calling shutdown,sargs==[::sargs::format $sargs]"; ::qw::shutdown; } ::return; } ::proc ::qw::service_utils::service_node_garbage_collect {} { ::switch -- $::tcl_platform(platform) { "windows" { /* { Managing service_hub and service_node names. Each service_hub gets a service_hub_id of the form [::clock seconds][::pid] which should be unique for all time. This id is generated when the service_hub boots and it then places it in the windows service manager configuration -command option for the service_hub service. When a service_node is created it is given a service_node_id which is just an auto-incremented number from the service_hub. It is passed to the service_node in the command line as -service_node_id. The service_hub_id is also passed to the service_node in the command line. Garbage Collection ------------------ We get all of the records from the windows service manager. We recognize service_nodes and hubs by the configuration option/value pairs "-314120160407135741 service_node" and "-314120160407135741 service_hub" respectively. We extract -service_hub_id from each service node and see if there is a service_hub with that id. If not, we have an orphan service_node and we need to uninstall it. Notes: (1) We are using the -command option like a "clientdata". (2) We impose no restrictions on the service_names of either service_hubs or service_nodes. (3) A service_hub is given a name by the newviews service manager (or nv2_install) when the service is installed. It will always have the same name. You can add another service if you want, with a different name. We don't care what the service_names are. (4) The service name in either case is passed in on commandline option -run__as__service. */ } /* { Get the list of all services. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,service_node_garbage_collect,1000.0";} ::set Result [::qw::service_utils::314120160407135741_list_get]; ::set ServiceHubNameList [::sargs::get $Result .service_hub_name_list]; ::set ServiceNodeNameList [::sargs::get $Result .service_node_name_list]; ::if {$rwb1_debug} {::puts "rwb1_debug,service_node_garbage_collect,1000.4,ServiceNodeNameList==$ServiceNodeNameList";} ::set OrphanList [::list]; ::foreach ServiceNodeName $ServiceNodeNameList { /* { Loop through the service_node services and determine if any of them are orphans because we can't find their (running) service_hub. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,service_node_garbage_collect,1000.6,ServiceNodeName==$ServiceNodeName";} ::switch -- $::tcl_version { 8.4 { ::set Service [::twapi::get_service_configuration $ServiceNodeName -command]; } 8.6 { ::set Service [::twapi::get_service_configuration $ServiceNodeName -command]; } } ::set Commandline [::lindex $Service 1]; ::if {$rwb1_debug} {::puts "rwb1_debug,service_node_garbage_collect,1000.6.0,Commandline==$Commandline";} ::set Index [::lsearch $Commandline "-service_hub_id"]; ::if {$Index<0} { ::qw::bug 314120160407142011 "[::namespace current]::[::qw::procname] - no -service_hub_id in \"$Commandline\""; ::continue; } ::incr Index 1; ::set ServiceHubId [::lindex $Commandline $Index]; ::if {$rwb1_debug} {::puts "rwb1_debug,service_node_garbage_collect,1000.7";} ::set IsOrphan 1; ::foreach ServiceHubName $ServiceHubNameList { /* { Loop through the service_hubs to find the service_hub_id that was extracted from the service_node name. */ } ::set Commandline [::lindex [::twapi::get_service_configuration $ServiceHubName -command] 1]; ::set Index [::lsearch $Commandline "-service_hub_id"]; ::if {$Index<0} { ::qw::bug 314120160407142012 "[::namespace current]::[::qw::procname] - no -service_hub_id in \"$Commandline\""; ::continue; } ::incr Index 1; ::set CommandlineServiceHubId [::lindex $Commandline $Index]; ::if {$ServiceHubId eq $CommandlineServiceHubId} { /* { We found the service_hub that has the service_node's service_hub_id. So the service_node has a service_hub and is not an orphan. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,service_node_garbage_collect,1000.8";} ::set IsOrphan 0; ::break; } } ::if {$rwb1_debug} {::puts "rwb1_debug,service_node_garbage_collect,1000.8.0,ServiceNodeName==$ServiceNodeName,IsOrphan==$IsOrphan";} ::if {$IsOrphan} { /* { The service_node is an orphan. We searched the list of service_hubs and did not find the service_hub_id that the service_node belongs to. The service_node is an orphan. We shut it down and uninstall it from the windows service manager now. Note that service_destroy never throws exceptions. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,service_node_garbage_collect,1000.9";} ::qw::service_utils::service_destroy .service_name $ServiceNodeName; ::if {$rwb1_debug} {::puts "rwb1_debug,service_node_garbage_collect,1000.10";} } } ::if {$rwb1_debug} {::puts "rwb1_debug,service_node_garbage_collect,1000.99";} } "unix" { /* { Go through the list of service_nodes in the service_process_file. If a service node is not running, delete it from the service_process_file. If the service_node is running, check to see if it's service_hub is running. If not then the service node is an orphan and we will kill it. Killing the service node should also remove it from the service_process_file but we'll also do that here just to be sure. Find all services that are not running and remove them from kill them. We are going to have a problem finding the service_process_file when installing. One solution will be to find a place other than the program folder, that is global to all nv programs. */ } /* { Get the list of all services. */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,service_node_garbage_collect,1000.00";} ::set ServiceHubList [::list]; ::set ServiceNodeList [::list]; ::set RecordList [::sargs::file::get $::qw::service_utils::linux_process_file]; ::if {$rwb1_debug} {::puts "rwb1_debug,service_node_garbage_collect,1000.01,RecordList==\n[::sargs::format $RecordList]";} ::foreach {Name Record} $RecordList { /* { Prune out any records whose process id is not running. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,service_node_garbage_collect,1000.02,Name==$Name,Record==$Record";} ::if {![process_is_running $Record]} { ::if {$rwb1_debug} {::puts "rwb1_debug,service_node_garbage_collect,1000.03,record==\n[::sargs::format $Record]";} ::sargs::file::unset $::qw::service_utils::linux_process_file $Name; ::continue; } ::switch -- [::sargs::get $Record .service_app_name] { "app_name_service_hub" { ::sargs::var::set ServiceHubList $Name $Record; } "app_name_service_node" { ::sargs::var::set ServiceNodeList $Name $Record; } } } /* { Note that all records now correspond to running processes. */ } ::set OrphanNameList [::list]; ::foreach {ServiceNodeName ServiceNodeRecord} $ServiceNodeList { /* { For each service_node see if it's service_hub is running. */ } ::set ServiceNodeProcessId [::sargs::get $ServiceNodeRecord .process_id]; ::set ServiceHubProcessId [::sargs::get $ServiceNodeRecord .service_hub_process_id]; ::set Found 0; ::foreach {HubName HubRecord} $ServiceHubList { /* { Search the active hubs. */ } ::if {[::sargs::get $HubRecord .process_id] eq $ServiceHubProcessId} { ::set Found 1; ::break; } } ::if {!$Found} { /* { If no active hub was found then the service_node is an orphan. */ } ::kill SIGTERM $ServiceNodeProcessId; } } } } } ############################################################################ /* { This code is run as a script to isolate how NV2 runs as a service. The main thing is to open a server database and load it's root port, which in turn will recursively load all ports below, thus opening their sockets. In particular we do not want to "gui_load" anything. Then we have to call the twapi run_as_service method and set up to respond to callbacks. A key observation is that the server is running as a service and does not habe a user interface. It opens a server database and opens associated ports, but does not open a server window system on the server database. Instead, a remote server window system can open the server database. (Note this is true even if the server is not a service). When running as a server, the server can also run as a server_hub, launching server nodes. If that is the case, however, the server_nodes will also run as services. */ } ::proc ::qw::service_utils::run_as_service {sargs} { ::if {$::qw::control(process_file_is_enabled)} { ::qw::bug 314120190610145740 "::qw::service_utils::run_as_service - can't run as service when process file is enabled."; } ::switch -- $::tcl_platform(platform) { "windows" { ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::run_as_service,1000.0,sargs==\n[::sargs::format $sargs]";} ::set ServiceName [::sargs::get $::qw_sargv .run_as_service]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::run_as_service,1000.1,ServiceName==$ServiceName";} /* { twapi::run_as_service is called with a list of service_name/service_handler pairs. Of course we are supplying only one pair. This call does not return until the service is ready to exit. */ } ::twapi::run_as_service \ [::list [::list $ServiceName ::qw::service_utils::service_control_handler_windows]] \ ; ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service,main,1000.99";} } "unix" { ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service,1000.00";} /* { There is no service name in unix. We will use the process id as the service name and for consistency with Windows, will use .service_name argument in method calls. Note that the service name in Windows is passed in as the .run_as_service value. Here we will isgnore that value. */ } # ::set ServiceName [::sargs::get $::qw_sargv .run_as_service]; ::set ServiceName [::pid]; /* { twapi::run_as_service is called with a list of service_name/service_handler pairs. Of course we are supplying only one pair. This call does not returned until the service is ready to exit. */ } ::set Record [::sargs]; ::set Pid [pid]; ::sargs::var::set Record .process_id $Pid; ::sargs::var::set Record .service_name $ServiceName; ::sargs::var::set Record .service_app_name $::qw::control(app_name); ::switch -- $::qw::control(app_name) { "app_name_service_hub" { } "app_name_service_node" { ::sargs::var::set Record .service_hub_id [::sargs::get $::qw_sargv .service_hub_id]; ::sargs::var::set Record .service_hub_process_Id [::sargs::get $::qw_sargv .service_hub_process_id]; ::sargs::var::set Record .service_node_Id [::sargs::get $::qw_sargv .service_node_id]; } } ::set Data [::sargs::file::get $::qw::service_utils::linux_process_file]; ::if {[::sargs::exists $Data .$Pid]} { ::qw::bug 314120180326161939 "[::namespace current]::[::qw::procname] - unexpected process id $Pid."; } ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service,1000.10,record==\n[::sargs::format $Record]";} ::sargs::file::set $::qw::service_utils::linux_process_file .$Pid $Record; ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service,1000.11.0,have_posix_signals==[::infox have_posix_signals]";} ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service,1000.11.1,have_restart_signal==[::infox have_signal_restart]";} # signal -restart trap SIGTERM [::list ::qw::service_utils::service_control_handler_linux .signal SIGTERM]; # signal -restart trap 15 [::list ::qw::service_utils::service_control_handler_linux .signal SIGKILL]; signal -restart trap SIGTERM [::list ::qw::service_utils::service_control_handler_linux %S]; signal -restart trap 15 [::list ::qw::service_utils::service_control_handler_linux %S]; ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service,1000.12";} # signal -restart trap SIGKILL [::list ::qw::service_utils::service_control_handler .signal SIGKILL]; # signal -restart trap 15 [::list ::qw::service_utils::service_control_handler_linux .signal SIGKILL]; ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service,1000.13";} } } } ::proc ::qw::service_utils::run_as_service_shutdown {} { /* { 20210415 - who calls run_as_service_shutdown? - service_control_handler in service_utils - service_node_connection_destroy - qw::bug_process who calls service_node_application_exit? service_node destructor service_node_signal_receive service_node_connection_destroy who calls service_destroy? destroy_all garbage_collect nv2_install service_hub_connection_destroy service_hub service_node_destroy service_hub_application_exit service_node_application_exit windows_service_installer */ } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service_shutdown,1000.0,app_name==$::qw::control(app_name)";} ::if {$rwb1_debug} { ::qw::stack_dump; } ::switch -- $::tcl_platform(platform) { "windows" { } "unix" { ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service_shutdown,1000.8";} ::sargs::file::unset $::qw::control(process_list_file) .[::pid]; ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service_shutdown,1000.9";} } } ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service_shutdown,1000.0";} ::if {[::qw::command_exists ::qw::service_hub::singleton]} { ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service_shutdown,1000.1";} ::qw::try { ::itcl::delete object ::qw::service_hub::singleton; } catch dummy { # 0 occurrences as at 20210322 ::qw::warning [::subst { .text "[::namespace current]::[::qw::procname] - exception==$dummy" .warning_id 314120180416110345 .send_warning_to_mothership 1 }]; ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service_shutdown,1000.1.0,exception==$dummy";} } ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service_shutdown,1000.2";} } ::if {[::qw::command_exists ::qw::service_node::singleton]} { ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service_shutdown,1000.3";} ::qw::try { ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service_shutdown,1000.3.0";} ::itcl::delete object ::qw::service_node::singleton; ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service_shutdown,1000.3.1";} } catch dummy { # 0 occurrences as at 20210322 ::qw::warning [::subst { .text "[::namespace current]::[::qw::procname] - exception==$dummy" .warning_id 314120180416110346 .send_warning_to_mothership 1 }]; ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service_shutdown,1000.3.2,exception==$dummy";} } ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service_shutdown,1000.4";} #2.38.3 ::return; } ::if {[::qw::command_exists ::qw::system]} { ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service_shutdown,1000.5";} # [::qw::system] cpp_shutdown_cleanup; ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service_shutdown,1000.6";} } ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service_shutdown,1000.7";} ::qw::exit; ::if {$::qw::control(service_shutdown_bug)} { ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service_shutdown,1000.8";} ::qw::shutdown; ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service_shutdown,1000.9";} ::qw::throw .text "run as service shutdown call" .priority ignore; ::return; } ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service_shutdown,1000.10";} # 2.32.3 added .force_shutdown ::qw::shutdown .force_shutdown 1; ::if {$rwb1_debug} {::puts "rwb1_debug,run_as_service_shutdown,1000.11";} } ::proc ::qw::service_utils::report_state {ServiceName Sequence ServiceState} { ::switch -- $::tcl_platform(platform) { "windows" { ::qw::try { ::twapi::update_service_status $ServiceName $Sequence $ServiceState; } catch Exception { ::qw::warning 314120160712153414 "Service $ServiceName failed to update status: \"$Exception\"." #::twapi::eventlog_log "Service $ServiceName failed to update status: \"$Exception\"." } } "unix" { ::qw::bug "314120180329081837" "[::namespace current]::[::qw::procname] - Can't call this method in linux."; } } } ::proc ::qw::service_utils::service_control_handler_windows {Control {ServiceName ""} {Sequence 0} args} { ::switch -- $::tcl_platform(platform) { "windows" { } "unix" { } } ::set rwb1_debug 0; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler,0000,0,ServiceName==$ServiceName";} ::switch -exact -- $Control { start { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler,start,1000.0,seconds==[::clock seconds]";} ::qw::service_utils::report_state $ServiceName $Sequence "running"; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler,start,1000.1,seconds==[::clock seconds]";} } stop { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler,stop,1000.0";} ::qw::service_utils::run_as_service_shutdown; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler,stop,1000.1";} ::qw::service_utils::report_state $ServiceName $Sequence "stopped"; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler,stop,1000.2";} } pause { /* { We can't pause or continue and we should never received this command anyway. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler,pause,1000.0";} ::qw::service_utils::report_state $ServiceName $Sequence "running"; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler,pause,1000.1";} } continue { /* { We can't pause or continue and we should never received this command anyway. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler,continue,1000.0";} ::qw::service_utils::report_state $ServiceName $Sequence "running"; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler,continue,1000.1";} } userdefined { # Note we do not need to call update_service_status } all_stopped { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler,all_stopped,1000.0";} ::qw::service_utils::run_as_service_shutdown; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler,all_stopped,1000.1";} } shutdown { /* { The system is shutting down I guess, as we are supposed to handle this much like we handle stop? We will copy the code from stop. */ } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler,shutdown,1000.0,seconds==[::clock seconds]";} ::if {[::qw::command_exists ::qw::system]} { [::qw::system] cpp_shutdown_cleanup; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler,shutdown,1000.1,seconds==[::clock seconds]";} ::qw::service_utils::run_as_service_shutdown; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler,shutdown,1000.2,seconds==[::clock seconds]";} ::qw::service_utils::report_state $ServiceName $Sequence "stopped"; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler,shutdown,1000.3,seconds==[::clock seconds]";} } default { # Ignore } } } ::proc ::qw::service_utils::service_control_handler_linux {Signal} { ::set rwb1_debug 0; # ::set Signal [::sargs::get $sargs .signal]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler_linux,shutdown,1000.0,seconds==[::clock seconds],sargs==$sargs";} ::switch -exact -- $Signal { 15 - KILL - TERM - SIGKILL - SIGTERM { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler_linux,1000.0,seconds==[::clock seconds]";} ::if {[::qw::command_exists ::qw::system]} { [::qw::system] cpp_shutdown_cleanup; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler_linux,1000.1,seconds==[::clock seconds]";} ::qw::service_utils::run_as_service_shutdown; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::linux_service::service_control_handler_linux,1000.2,seconds==[::clock seconds]";} # ::qw::linux_service::report_state $ServiceName $Sequence "stopped"; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler_linux,1000.3,seconds==[::clock seconds]";} } default { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler_linux,1000.4,seconds==[::clock seconds]";} # Ignore } } } /* { ::proc ::qw::service_utils::service_control_handler_linux {sargs} { ::set rwb1_debug 0; ::set Signal [::sargs::get $sargs .signal]; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler_linux,shutdown,1000.0,seconds==[::clock seconds],sargs==$sargs";} ::switch -exact -- $Signal { SIGKILL - SIGNTERM { ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler_linux,shutdown,1000.0,seconds==[::clock seconds]";} ::if {[::qw::command_exists ::qw::system]} { [::qw::system] cpp_shutdown_cleanup; } ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler_linux,shutdown,1000.1,seconds==[::clock seconds]";} run_as_service_shutdown; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::linux_service::service_control_handler_linux,shutdown,1000.2,seconds==[::clock seconds]";} # ::qw::linux_service::report_state $ServiceName $Sequence "stopped"; ::if {$rwb1_debug} {::puts "rwb1_debug,::qw::service_utils::service_control_handler_linux,shutdown,1000.3,seconds==[::clock seconds]";} } default { # Ignore } } } */ } ::proc ::qw::service_utils::process_is_running {sargs} { ::switch -- $::tcl_platform(platform) { "windows" { ::qw::bug "314120180329080554" "[::namespace current]::[::qw::procname] - Can't call this method in windows."; } "unix" { ::set ProcessId [::sargs::get $sargs .process_id]; ::if {$ProcessId eq ""} { ::qw::bug 314120180326172138 "[::namespace current]::[::qw::procname] - no .process_id argument."; } ::if {[::file exists /proc/$ProcessId]} { /* { In linux, the /proc directory contains virtual files, one per process. Each such file's name is the corresponding process id. */ } ::return 1; } ::return 0; } } } ::proc ::qw::service_utils::service_hub_is_running {sargs} { ::switch -- $::tcl_platform(platform) { "windows" { ::qw::bug "314120180329080554" "[::namespace current]::[::qw::procname] - Can't call this method in windows."; } "unix" { ::set rwb1_debug 0; ::set RecordList [::sargs::file::get $::qw::service_utils::linux_process_file]; ::set Count 0; ::foreach {Name Record} $RecordList { ::switch -- [::sargs::get $Record .service_app_name] { "app_name_service_hub" { ::if {[process_is_running $Record]} { ::return 1; } } } } ::return 0; } } }