# 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
  }

  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 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
          }
      }
  }

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