Posted to tcl by rudenstam at Sun Oct 14 21:01:53 GMT 2007view raw

  1. #!/usr/bin/tclsh
  2.  
  3. package require tls
  4. package require mysqltcl
  5.  
  6. set ::mysql(user) ""
  7. set ::mysql(pass) ""
  8. set ::mysql(host) ""
  9. set ::mysql(port) ""
  10. set ::mysql(db) ""
  11. set ::mysql(table) ""
  12.  
  13. set port 32081
  14.  
  15. proc mysql_connect { } {
  16. global mysql
  17. return [::mysql::connect -user $mysql(user) -pass $mysql(pass) -host $mysql(host) -port $mysql(port) -db $mysql(db)]
  18. }
  19.  
  20. ###########
  21. # stdin #
  22. ###########
  23. fileevent stdin readable {
  24. if { [gets stdin in] > 0 } {
  25. switch $in {
  26. exit { exit }
  27. rehash {
  28. if { [catch { source tlsrelay.tcl } err] } {
  29. puts "Failed to rehash: \n$err"
  30. } else {
  31. puts "Rehashed successfully"
  32. }
  33. }
  34. default {
  35. if { [catch {puts [eval $in]} msg] } {
  36. puts $msg
  37. }
  38. }
  39. }
  40. }
  41. }
  42.  
  43. ####################################
  44. # Print status once every minute #
  45. ####################################
  46. proc status { } {
  47. puts "[clock format [clock scan now] -format "%Y-%m-%d %H:%M:%S"] <--> [expr ([llength [file channels]]-3)/2] clients connected"
  48. after 60000 status
  49. }
  50.  
  51. ##############################
  52. # Accepnt a new connection #
  53. ##############################
  54. proc accept { source h p } {
  55. puts "$source connected from $h using $p"
  56. set destin [socket 127.0.0.1 32091]
  57. fconfigure $destin -buffering line -translation binary
  58. fconfigure $source -buffering line -translation binary
  59.  
  60. set ::${source}(host) $h
  61.  
  62. fileevent $source readable [list forward $source $destin]
  63. fileevent $destin readable [list forward $destin $source]
  64. }
  65.  
  66. ###########################################
  67. # Forward traffic from one to the other #
  68. ###########################################
  69. proc forward { source destin } {
  70. # if either socket closed, close both
  71. if { [eof $source] || [eof $destin] } {
  72. puts "eof"
  73. if { [catch {close $source} err] } { puts "unable to close $source, $err" }
  74. if { [catch {close $destin} err] } { puts "unable to close $destin, $err" }
  75. if { [info exist ::$source] } {
  76. puts "$source closed ([set ::${source}(host)])"
  77. unset ::$source
  78. }
  79. if { [info exist ::$destin] } {
  80. puts "$destin closed ([set ::${destin}(host)])"
  81. unset ::$destin
  82. }
  83. return
  84. }
  85.  
  86. # if there's a problem reading source, close both sockets
  87. if { [catch {set data [gets $source]} err] } {
  88. puts "$source from [set ::${source}(host)] errored, disconnecting, error: $err"
  89. if { [catch {close $source} err] } { puts "unable to close $source, $err" }
  90. if { [catch {close $destin} err] } { puts "unable to close $destin, $err" }
  91. if { [info exist ::$source] } { unset ::$source }
  92. if { [info exist ::$destin] } { unset ::$destin }
  93. return
  94. }
  95. # login thingy, need to check ip here as the real server will just see 127.0.0.1 on all clients
  96. if { [string match -nocase ".login*" $data] } {
  97. set sql [mysql_connect]
  98. set query "SELECT accountUsername FROM $::mysql(table) WHERE accountUsername = '[lindex $data 1]' AND ('[set ::${source}(host)]' LIKE accountHost || '[set ::${source}(host)]' LIKE accountHostAlt)";
  99. set res [mysql::sel $sql $query]
  100. mysql::close $sql
  101. # if no results with the sql, print errors, close sockets and return
  102. if { $res == 0 } {
  103. puts "wrong ip"
  104. puts $source "system|warning|wrong username/pass/ip"
  105. if { [catch {
  106. close $destin
  107. close $source
  108. unset ::$source
  109. } err] } { puts "error: \n$err" }
  110. return
  111. }
  112. }
  113.  
  114. # otherwise, forward data
  115. if { [string trim $data] != "" } {
  116. puts $destin $data
  117. }
  118. }
  119.  
  120. ########################
  121. # First time startup #
  122. ########################
  123. if { ![info exist serverstate(running)] } {
  124. tls::socket -server accept -certfile server.cert -keyfile server.key -ssl2 1 -ssl3 1 -tls1 1 -request 0 -require 0 $port
  125. puts "Accepting connections on $port"
  126. set serverstate(running) 1
  127. after 60000 status
  128. vwait forever
  129. }
  130.