#! /usr/bin/env tclsh
package require tuapi
package require Thread
namespace eval ::tsmf {}
namespace eval ::tsmf::server {}
namespace eval ::tsmf::server::internal {}
namespace eval ::tsmf::client {}
namespace eval ::tsmf::_helper {}
set ::tsmf::_default_config {
path /tmp/.tsmf.sock
svcdir /lib/svc
confdirs /etc/svc
logdir /var/log/svc
}
proc ::tsmf::_helper::getConfig {name config} {
set config [dict merge $::tsmf::_default_config $config]
return [dict get $config $name]
}
proc ::tsmf::_helper::serializeRequest {id command argInfo} {
set data [dict create id $id command $command args [binary encode base64 $argInfo]]
return $data
}
proc ::tsmf::_helper::deserializeRequest {data} {
set id [dict get $data id]
set command [dict get $data command]
set args [binary decode base64 [dict get $data args]]
return [dict create id $id command $command args $args]
}
proc ::tsmf::_helper::serializeResponse {id result} {
set data [dict create id $id result [binary encode base64 $result]]
return $data
}
proc ::tsmf::_helper::deserializeResponse {data} {
set id [dict get $data id]
set result [binary decode base64 [dict get $data result]]
return [dict create id $id result $result]
}
# Setup the service handler as "init"
proc ::tsmf::server::init {{config {}}} {
set socketName [::tsmf::_helper::getConfig path $config]
file delete -force $socketName
::tuapi::syscall::socket_unix -server ::tsmf::server::accept $socketName
array set ::tsmf::server::svcs {}
::tsmf::server::scan $config
after 0 [list ::tsmf::server::poll $config]
}
proc ::tsmf::server::internal::start {svcname svcscript svclog options} {
set tid [thread::create]
thread::send -async $tid [list set ::auto_path $::auto_path]
thread::send -async $tid [list package require tuapi]
thread::send -async $tid [list apply {{svcname svcscript svclog options} {
set code [catch {
file mkdir [file dirname $svclog]
dict with options {
set pgid [::tuapi::syscall::tsmf_start_svc $svcname $svcscript $svclog $env $dir $umask $uid $gid $timeout]
}
} output options]
set result [list code $code output $output options $options]
if {[info exists pgid]} {
lappend result pgid $pgid
}
return -level 0 $result
}} $svcname $svcscript $svclog $options] ::tsmf::server::internal::_result($tid)
vwait ::tsmf::server::internal::_result($tid)
set result $::tsmf::server::internal::_result($tid)
unset ::tsmf::server::internal::_result($tid)
thread::release $tid
if {[dict get $result code] != 0} {
return -code [dict get $result code] -options [dict get $result options] [dict get $result output]
}
set pgid [dict get $result pgid]
return $pgid
}
proc ::tsmf::server::internal::log {svcname message} {
set svclog [dict get $::tsmf::server::svcs($svcname) svclog]
set timestamp [clock format [clock seconds] -format {%b %e %H:%M:%S}]
catch {
set fd [open $svclog a]
foreach line [split $message \n] {
puts $fd "\[ $timestamp $line \]"
}
}
catch {
close $fd
}
}
proc ::tsmf::server::internal::stop {svcname svcstate} {
log $svcname "Killing $svcname"
# Terminate the process group
catch {
set pgid [dict get $svcstate pgid]
::tuapi::syscall::kill -$pgid 9
}
}
proc ::tsmf::server::notify {} {
set ::tsmf::server::pollidx -1
}
proc ::tsmf::server::poll {config} {
# Every 100ms we check to see if we should be doing anything, but
# don't do anything except every 10 checks, this way we can be called
# notify without being in the stack
if {![info exists ::tsmf::server::pollidx]} {
set ::tsmf::server::pollidx -1
}
after 100 [list ::tsmf::server::poll $config]
incr ::tsmf::server::pollidx
if {($::tsmf::server::pollidx % 10) != 0} {
return
}
if {($::tsmf::server::pollidx % 300) == 0} {
# Scan for any new services
::tsmf::server::scan $config
}
foreach svcname [array names ::tsmf::server::svcs] {
set stateVar ::tsmf::server::svcs($svcname)
unset -nocomplain state
array set state [set $stateVar]
# Detect oneshot services
set oneshot false
if {[dict exists $state(options) oneshot] && [dict get $state(options) oneshot]} {
set oneshot true
}
# Skip services that are starting or stopping
if {$state(state) eq "starting" || $state(state) eq "stopping"} {
continue
}
# We may want to consider services that do want to be started
# as wanting to be stopped, if their dependencies are not met
set desired_state $state(desired_state)
# Ensure all the requirements are met
set dependencies [dict get $state(options) requires]
dict unset $stateVar down_deps
unset -nocomplain state(down_deps)
foreach dependency $dependencies {
set dependency_state [::tsmf::server::state $dependency]
if {$dependency_state eq "started"} {
continue
}
set desired_state stopped
if {$state(desired_state) ne "stopped"} {
dict lappend $stateVar down_deps $dependency
lappend state(down_deps) $dependency
}
}
# Check if the service is in the desired state
if {$desired_state eq $state(state)} {
unset -nocomplain state(reason)
set ::tsmf::server::svcs($svcname) [array get state]
# If the desired state is down, and we are down, we
# don't need to verify that
if {$desired_state eq "stopped"} {
continue
}
# We can't verify oneshot services
if {$oneshot} {
continue
}
# Verify that the service is still running
if {[catch {
::tuapi::syscall::kill -$state(pgid) 0
}]} {
::tsmf::server::internal::log $svcname "Service died unexpectedly"
set state(changed_time) [clock seconds]
set state(state) stopped
set state(reason) "Service died unexpectedly"
unset -nocomplain state(pgid)
set ::tsmf::server::svcs($svcname) [array get state]
::tsmf::server::notify
}
continue
}
if {$oneshot && $desired_state eq "stopped"} {
set state(reason) "Cannot stop one-shot service"
set ::tsmf::server::svcs($svcname) [array get state]
continue
}
# Enact the change the state of the service
unset -nocomplain state
dict set $stateVar locked true
dict set $stateVar changed_time [clock seconds]
dict unset $stateVar reason
dict unset $stateVar fail_time
switch -exact -- $desired_state {
started {
dict set $stateVar state starting
set svcscript [dict get [set $stateVar] svcscript]
set svclog [dict get [set $stateVar] svclog]
set options [dict get [set $stateVar] options]
if {[catch {
set pgid [::tsmf::server::internal::start $svcname $svcscript $svclog $options]
} msg]} {
::tsmf::server::internal::log $svcname "Service failed to start: $msg"
dict set $stateVar state stopped
dict set $stateVar reason $msg
dict set $stateVar fail_time [clock seconds]
dict unset $stateVar pgid
} else {
dict set $stateVar state started
dict set $stateVar pgid $pgid
}
}
stopped {
dict set $stateVar state stopping
if {[catch {
::tsmf::server::internal::stop $svcname [set $stateVar]
} msg]} {
::tsmf::server::internal::log $svcname "Service failed to stop: $msg"
dict set $stateVar state started
dict set $stateVar reason $msg
dict set $stateVar fail_time [clock seconds]
} else {
dict set $stateVar state stopped
dict unset $stateVar pgid
}
}
}
dict set $stateVar changed_time [clock seconds]
dict unset $stateVar locked
array set state [set $stateVar]
if {[info exists state(next_desired_state)]} {
dict set $stateVar desired_state $state(next_desired_state)
dict unset $stateVar next_desired_state
::tsmf::server::notify
}
if {$state(state) eq $desired_state} {
::tsmf::server::notify
}
}
}
proc ::tsmf::server::accept {sock uid gid pid} {
fconfigure $sock -blocking false -encoding utf-8 -buffering line
fileevent $sock readable [list apply {{sock uid gid pid} {
set data ""
catch {
set data [gets $sock]
}
if {$data eq "" && [eof $sock]} {
catch {
close $sock
}
return
}
if {$data eq ""} {
return
}
set dataDict [::tsmf::_helper::deserializeRequest $data]
dict with dataDict {
if {$command in {start stop status list_svcs}} {
set resultCode [catch {uplevel #0 [list ::tsmf::server::$command {*}$args]} output]
} else {
set resultCode 1
set output "Unknown command: $command"
}
catch {
puts $sock [::tsmf::_helper::serializeResponse $id [list code $resultCode output $output]]
}
catch {
flush $sock
}
}
}} $sock $uid $gid $pid]
}
# Scan for services
proc ::tsmf::server::scan {config} {
set config_svcdir [::tsmf::_helper::getConfig svcdir $config]
set services [glob -tails -nocomplain -directory $config_svcdir -type f * */* */*/* */*/*/* */*/*/*/*]
foreach name $services {
if {[string match "*.*" $name]} {
continue
}
set svcname svc://$name
if {[info exists ::tsmf::server::svcs($svcname)]} {
continue
}
if {[info exists ::tsmf::server::svcs_ignore($svcname)]} {
continue
}
set svcscript [file join $config_svcdir $name]
set ignore [apply {{svcscript} {
set retval false
catch {
set fd [open $svcscript]
set script [read $fd]
if {[regexp -lineanchor {^#[[:space:]]*TSMF-IGNORE$} $script]} {
set retval true
}
}
catch {
close $fd
}
return $retval
}} $svcscript]
if {$ignore} {
set ::tsmf::server::svcs_ignore($svcname) true
continue
}
::tsmf::server::add $name $config
}
}
# Add a service to the service registry (stopped)
proc ::tsmf::server::add {name config {manual_options {}}} {
set config_svcdir [::tsmf::_helper::getConfig svcdir $config]
set config_logdir [::tsmf::_helper::getConfig logdir $config]
set config_confdirs [::tsmf::_helper::getConfig confdirs $config]
set svcname svc://$name
set svcscript [file join $config_svcdir {*}[split $name /]]
set svclog [file join $config_logdir [join [split $name /] -].log]
# Load configuration
foreach option_confdir [list $config_svcdir {*}$config_confdirs] {
set option_conffile_base [file join $option_confdir {*}[split $name /]]
lappend option_files ${option_conffile_base}.conf
foreach option_conffile [lsort -dictionary [glob -nocomplain -type f ${option_conffile_base}.*.conf]] {
lappend option_files [file join $option_confdir $option_conffile]
}
}
# Default options
set options {
env {}
dir /
umask 022
uid 0
gid 0
timeout 60
requires {}
}
# Load config from the service script
unset -nocomplain option_data
set option_data [apply {{svcscript} {
set retval [dict create]
catch {
set fd [open $svcscript]
set script [read $fd]
foreach line [split $script \n] {
if {![regexp {^#[[:space:]]*TSMF: (.*)$} $line -> option_data]} {
continue
}
set retval [string trim $option_data]
break
}
}
catch {
close $fd
}
return $retval
}} $svcscript]
catch {
set options [dict merge $options $option_data]
}
# Load config files
foreach option_file $option_files {
if {[file exists $option_file]} {
unset -nocomplain fd option_data
catch {
set fd [open $option_file]
set option_data [read $fd]
set options [dict merge $options $option_data]
}
catch {
close $fd
}
}
}
# Apply manual options
set options [dict merge $options $manual_options]
# If the "ignore" option is set, ignore the service altogether
if {[dict exists $options ignore] && [dict get $options ignore]} {
set ::tsmf::server::svcs_ignore($svcname) true
return
}
unset -nocomplain ::tsmf::server::svcs_ignore($svcname)
set state {
state stopped
desired_state stopped
}
# If the desired state is specified in the options, use that
if {[dict exists $options desired_state]} {
dict set state desired_state [dict get $options desired_state]
}
# If the service has already been added, use the existing state
if {[info exists ::tsmf::server::svcs($svcname)]} {
set state $::tsmf::server::svcs($svcname)
}
dict set state svcname $svcname
dict set state svcscript $svcscript
dict set state svclog $svclog
dict set state options $options
dict set state changed_time [clock seconds]
set ::tsmf::server::svcs($svcname) $state
return $svcname
}
# Set desired state
proc ::tsmf::server::setDesiredState {name desired_state} {
if {![info exists ::tsmf::server::svcs($name)]} {
return false
}
set stateInfo $::tsmf::server::svcs($name)
# If the service is locked (e.g., because it is starting or stopping)
# we must not change the desired state, instead we set the "next_desired_state"
if {[dict exists $stateInfo locked] && [dict get $stateInfo locked]} {
set property next_desired_state
} else {
set property desired_state
}
dict set stateInfo $property $desired_state
set ::tsmf::server::svcs($name) $stateInfo
if {$property eq "desired_state"} {
::tsmf::server::notify
}
return true
}
# Start a service
proc ::tsmf::server::start {svcname {options {}}} {
return [::tsmf::server::setDesiredState $svcname started]
}
# Stop a service
proc ::tsmf::server::stop {svcname} {
return [::tsmf::server::setDesiredState $svcname stopped]
}
# Get service status
proc ::tsmf::server::status {svcname} {
if {[info exists ::tsmf::server::svcs($svcname)]} {
set state $::tsmf::server::svcs($svcname)
} else {
set state {}
}
return $state
}
proc ::tsmf::server::state {svcname} {
set stateInfo [::tsmf::server::status $svcname]
if {[dict exists $stateInfo state]} {
return [dict get $stateInfo state]
}
return unknown
}
# Wait for a service to reach a specified state
proc ::tsmf::_helper::wait {impl svcname state {timeout -1}} {
set now [clock milliseconds]
if {$timeout != -1} {
set end [expr {$now + $timeout}]
}
set workvar ::tsmf::_helper::wait([clock clicks][expr {rand()}])
while true {
set found_state [::tsmf::${impl}::state $svcname]
if {$state eq $found_state} {
return true
}
set now [clock milliseconds]
if {$timeout != -1 && $now > $end} {
break
}
after 100 [list set $workvar 1]
vwait $workvar
unset -nocomplain $workvar
}
return false
}
proc ::tsmf::server::wait {svcname state {timeout -1}} {
return [::tsmf::_helper::wait server $svcname $state $timeout]
}
proc ::tsmf::client::wait {svcname state {timeout -1}} {
return [::tsmf::_helper::wait client $svcname $state $timeout]
}
# Get a list of known services
proc ::tsmf::server::list_svcs {} {
array set retval {}
foreach {name stateInfo} [array get ::tsmf::server::svcs] {
set retval($name) [apply {{name stateInfo} {
dict with stateInfo {
set output [dict create state $state desired_state $desired_state changed_time $changed_time]
}
if {[info exists reason]} {
dict set output reason $reason
}
if {[info exists down_deps]} {
dict set output down_deps $down_deps
}
return -level 0 $output
}} $name $stateInfo]
}
return [array get retval]
}
proc ::tsmf::_helper::connect {} {
set fd [::tuapi::syscall::socket_unix [::tsmf::_helper::getConfig path {}]]
return $fd
}
proc ::tsmf::_helper::sendRequest {command args} {
set fd [::tsmf::_helper::connect]
set id "1"
set data [::tsmf::_helper::serializeRequest $id $command $args]
puts $fd $data
flush $fd
fileevent $fd readable [list apply {{fd} {
set data ""
catch {
set data [gets $fd]
}
if {$data eq "" && [eof $fd]} {
catch {
close $fd
}
return
}
if {$data eq ""} {
return
}
set dataDict [::tsmf::_helper::deserializeResponse $data]
set ::tsmf::_helper::result([dict get $dataDict id]) [dict get $dataDict result]
}} $fd]
vwait ::tsmf::_helper::result($id)
set code [dict get $::tsmf::_helper::result($id) code]
set output [dict get $::tsmf::_helper::result($id) output]
unset ::tsmf::_helper::result($id)
return -code $code $output
}
# Start a service
proc ::tsmf::client::start {name {options {}}} {
return [::tsmf::_helper::sendRequest start $name $options]
}
# Stop a service
proc ::tsmf::client::stop {svcname} {
return [::tsmf::_helper::sendRequest stop $svcname]
}
# Get service status
proc ::tsmf::client::status {svcname} {
return [::tsmf::_helper::sendRequest status $svcname]
}
# Get a list of known services
proc ::tsmf::client::list_svcs {} {
return [::tsmf::_helper::sendRequest list_svcs]
}
package provide tsmf 0.1