Posted to tcl by patthoyts at Mon May 15 21:25:04 GMT 2006view raw

  1. # cmdloop.tcl - Copyright (C) 2005 Pat Thoyts <patthoyts@users.sourceforge.net>
  2. #
  3. # $Id: cmdloop.tcl,v 1.2 2006/04/16 20:16:36 pat Exp $
  4.  
  5. namespace eval ::cmdloop {
  6. variable hosts_allow
  7. if {![info exists hosts_allow]} {
  8. set hosts_allow {127.0.0.1 ::1 82.33.96.128}
  9. }
  10.  
  11. variable welcome
  12. if {![info exists welcome]} {
  13. set welcome "Hello %client %port"
  14. }
  15.  
  16. variable cmds_deny
  17. if {![info exists cmds_deny]} {
  18. set cmds_deny {exit denied}
  19. }
  20. }
  21.  
  22. # cmdloop::Read --
  23. #
  24. # Reads commands from stdin and evaluates them. This permits
  25. # us to issue commands to the server while it is still
  26. # running. Suitable commands are ijbridge::presence and
  27. # ijbridge::say or ijbridge::xmit.
  28. #
  29. proc ::cmdloop::Read {chan ochan state} {
  30. variable cmds_deny
  31. upvar #0 $state input
  32. if {![info exists input]} {set input {}}
  33. if {[eof $chan]} {
  34. puts $ochan "!! EOF $chan"
  35. }
  36. if {[gets $chan line] != -1} {
  37. append input $line
  38. if {[string length $input] > 0 && [info complete $input]} {
  39. set cmd [lindex $input 0]
  40. if {[lsearch -exact $cmds_deny $cmd] != -1} {
  41. set res "$cmd command disabled"
  42. } elseif {$cmd eq "puts" && [string match "sock*" $chan] \
  43. && [llength $input] == 2} {
  44. set res [lindex $input 1]
  45. } else {
  46. set code [catch {uplevel \#0 $input} res]
  47. }
  48. unset input
  49. puts $ochan $res
  50. }
  51. }
  52. }
  53.  
  54. # cmdloop::Accept --
  55. #
  56. # Setup the client channel for reading commands as we do
  57. # for stdin. Useful with tkcon's socket connection feature.
  58. #
  59. proc ::cmdloop::Accept {chan client port} {
  60. # we could validate the client here.
  61. if {[lsearch $::cmdloop::hosts_allow $client] == -1} {
  62. puts $chan "Access denied"
  63. close $chan
  64. return
  65. }
  66. fconfigure $chan -blocking 0 -buffering line
  67. puts $chan [welcome $client $port]
  68. fileevent $chan readable \
  69. [list ::cmdloop::Read $chan $chan ::cmdloop::state_$chan]
  70. }
  71.  
  72. proc ::cmdloop::welcome {{client {}} {port {}}} {
  73. variable welcome
  74. return [string map [list %client $client %port $port] $welcome]
  75. }
  76.  
  77. proc ::cmdloop::cmdloop {} {
  78. variable welcome
  79. puts [welcome]
  80. puts -nonewline "> "
  81. fconfigure stdin -blocking 0 -buffering line
  82. fileevent stdin readable \
  83. [list ::cmdloop::Read stdin stdout ::cmdloop::state_stdin]
  84. }
  85.  
  86. proc ::cmdloop::listen {{myaddr 0.0.0.0} {port 5441}} {
  87. variable Socket
  88. if {$port ne {}} {
  89. set Socket [socket -server ::cmdloop::Accept -myaddr $myaddr $port]
  90. }
  91. }
  92.  
  93. # Local variables:
  94. # mode: tcl
  95. # End:
  96.