The main network echo server is basically the sample from the Tcl Developer Xchange [http://www.tcl.tk/about/netserver.html]. Adapted here to run as a Windows service using [TWAPI]. ---- Usage proc to display message and exit on error. Note the same script is used for installing/uninstalling the service as for running the service itself. ====== # A sample Windows service implemented in Tcl using TWAPI's windows # services module. # proc usage {} { puts stderr { Usage: tclsh echoservice.tcl install SERVICENAME -- installs the service as SERVICENAME tclsh echoservice.tcl uninstall SERVICENAME -- uninstalls the service Then start/stop the service using either "net start" or the services control manager GUI. } exit 1 } ======= ---- Then standard network echo server from the Xchange, slightly adapted to explicitly maintain state. When "paused", the server stays running but does not talk to the clients. ====== package require twapi ################################################################ # The echo_server code is almost verbatim from the Tcl Developers # Exchange samples. set echo(server_port) 2008; # Port the echo server should listen on set echo(state) stopped; # State of the server # echo_server -- # Open the server listening socket # and enter the Tcl event loop # # Arguments: # port The server's port number proc echo_server {} { global echo set echo(server_socket) [socket -server echo_accept $echo(server_port)] } # echo_accept -- # Accept a connection from a new client. # This is called after a new socket connection # has been created by Tcl. # # Arguments: # sock The new socket connection to the client # addr The client's IP address # port The client's port number proc echo_accept {sock addr port} { global echo if {$echo(server_state) ne "running"} { close $sock return } # Record the client's information set echo(addr,$sock) [list $addr $port $sock] # Ensure that each "puts" by the server # results in a network transmission fconfigure $sock -buffering line # Set up a callback for when the client sends data fileevent $sock readable [list echo $sock] } # echo -- # This procedure is called when the server # can read data from the client # # Arguments: # sock The socket connection to the client proc echo {sock} { global echo # Check end of file or abnormal connection drop, # then echo data back to the client. if {[eof $sock] || [catch {gets $sock line}]} { close $sock unset -nocomplain echo(addr,$sock) } else { puts $sock $line } } # # Close all sockets proc echo_close_shop {{serveralso true}} { global echo # Loop and close all client connections foreach {index conn} [array get echo addr,*] { close [lindex $conn 2]; # 3rd element is socket handle unset -nocomplain echo($index) } if {$serveralso} { close $echo(server_socket) unset -nocomplain echo(server_socket) } } # # A client of the echo service. # proc echo_client {host port} { set s [socket $host $port] fconfigure $s -buffering line return $s } # A sample client session looks like this # set s [echo_client localhost 2540] # puts $s "Hello!" # gets $s line ====== ---- The actual Windows-related code itself (the main point of this posting). Basically, a callback that accepts control codes from the Windows SCM and changes state appropriately. ====== ################################################################ # The actual service related code # # Update the SCM with our state proc report_state {name seq} { if {[catch { set ret [twapi::update_service_status $name $seq $::echo(server_state)] } msg]} { ::twapi::eventlog_log "Service $name failed to update status: $msg" } } # Callback handler proc service_control_handler {control {name ""} {seq 0} args} { global echo switch -exact -- $control { start { if {[catch { # Start the echo server echo_server set echo(server_state) running } msg]} { twapi::eventlog_log "Could not start echo server: $msg" } report_state $name $seq } stop { echo_close_shop set echo(server_state) stopped report_state $name $seq } pause { # Close all client connections but leave server socket open echo_close_shop false set echo(server_state) paused report_state $name $seq } continue { set echo(server_state) running report_state $name $seq } userdefined { # Note we do not need to call update_service_status set ::done 1; # Hard exit } all_stopped { # Mark we are all done so we can exit at global level set ::done 1 } default { # Ignore } } } ====== ---- And here's where the script actually starts running, parse arguments, and then depending on the option, either install/uninstall the service, or run as a service. ====== ################################################################ # Main code # Parse arguments if {[llength $argv] != 2} { usage } set service_name [lindex $argv 1] switch -exact -- [lindex $argv 0] { service { # We are running as a service if {[catch { twapi::run_as_service [list [list $service_name ::service_control_handler]] } msg]} { twapi::eventlog_log "Service error: $msg" } # We sit in the event loop until service control stop us through # the event handler vwait ::done } install { if {[twapi::service_exists $service_name]} { puts stderr "Service $service_name already exists" exit 1 } # Make the names a short name to not have to deal with # quoting of spaces in the path set exe [file nativename [file attributes [info nameofexecutable] -shortname]] set script [file nativename [file attributes [file normalize [info script]] -shortname]] twapi::create_service $service_name "$exe $script service $service_name" } uninstall { if {[twapi::service_exists $service_name]} { twapi::delete_service $service_name } } default { usage } } exit 0 ====== ---- !!!!!! %| enter categories here |% !!!!!!