tsmf.tcl at [d157ac314d]

File tsmf/lib/tsmf/tsmf.tcl artifact 0957ddcea6 part of check-in d157ac314d


#! /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