开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
remote.tcl
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：4k
源码类别：

通讯编程

开发平台：

Visual C++

remote.tcl：源码内容
  1. # This file contains Tcl code to implement a remote server that can be
  2. # used during testing of Tcl socket code. This server is used by some
  3. # of the tests in socket.test.
  4. #
  5. # Source this file in the remote server you are using to test Tcl against.
  6. #
  7. # Copyright (c) 1995-1996 Sun Microsystems, Inc.
  8. #
  9. # See the file "license.terms" for information on usage and redistribution
  10. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11. #
  12. # RCS: @(#) $Id: remote.tcl,v 1.3 1999/04/16 00:47:33 stanton Exp $
  14. # Initialize message delimitor
  16. # Initialize command array
  17. catch {unset command}
  18. set command(0) ""
  19. set callerSocket ""
  21. # Detect whether we should print out connection messages etc.
  22. if {![info exists VERBOSE]} {
  23.     set VERBOSE 0
  24. }
  26. proc __doCommands__ {l s} {
  27.     global callerSocket VERBOSE
  29.     if {$VERBOSE} {
  30. puts "--- Server executing the following for socket $s:"
  31. puts $l
  32. puts "---"
  33.     }
  34.     set callerSocket $s
  35.     if {[catch {uplevel #0 $l} msg]} {
  36. list error $msg
  37.     } else {
  38. list success $msg
  39.     }
  40. }
  42. proc __readAndExecute__ {s} {
  43.     global command VERBOSE
  45.     set l [gets $s]
  46.     if {[string compare $l "--Marker--Marker--Marker--"] == 0} {
  47. if {[info exists command($s)]} {
  48.     puts $s [list error incomplete_command]
  49. }
  50. puts $s "--Marker--Marker--Marker--"
  51. return
  52.     }
  53.     if {[string compare $l ""] == 0} {
  54. if {[eof $s]} {
  55.     if {$VERBOSE} {
  56. puts "Server closing $s, eof from client"
  57.     }
  58.     close $s
  59. }
  60. return
  61.     }
  62.     append command($s) $l "n"
  63.     if {[info complete $command($s)]} {
  64. set cmds $command($s)
  65. unset command($s)
  66. puts $s [__doCommands__ $cmds $s]
  67.     }
  68.     if {[eof $s]} {
  69. if {$VERBOSE} {
  70.     puts "Server closing $s, eof from client"
  71. }
  72. close $s
  73.     }
  74. }
  76. proc __accept__ {s a p} {
  77.     global VERBOSE
  79.     if {$VERBOSE} {
  80. puts "Server accepts new connection from $a:$p on $s"
  81.     }
  82.     fileevent $s readable [list __readAndExecute__ $s]
  83.     fconfigure $s -buffering line -translation crlf
  84. }
  86. set serverIsSilent 0
  87. for {set i 0} {$i < $argc} {incr i} {
  88.     if {[string compare -serverIsSilent [lindex $argv $i]] == 0} {
  89. set serverIsSilent 1
  90. break
  91.     }
  92. }
  93. if {![info exists serverPort]} {
  94.     if {[info exists env(serverPort)]} {
  95. set serverPort $env(serverPort)
  96.     }
  97. }
  98. if {![info exists serverPort]} {
  99.     for {set i 0} {$i < $argc} {incr i} {
  100. if {[string compare -port [lindex $argv $i]] == 0} {
  101.     if {$i < [expr $argc - 1]} {
  102. set serverPort [lindex $argv [expr $i + 1]]
  103.     }
  104.     break
  105. }
  106.     }
  107. }
  108. if {![info exists serverPort]} {
  109.     set serverPort 2048
  110. }
  112. if {![info exists serverAddress]} {
  113.     if {[info exists env(serverAddress)]} {
  114. set serverAddress $env(serverAddress)
  115.     }
  116. }
  117. if {![info exists serverAddress]} {
  118.     for {set i 0} {$i < $argc} {incr i} {
  119. if {[string compare -address [lindex $argv $i]] == 0} {
  120.     if {$i < [expr $argc - 1]} {
  121. set serverAddress [lindex $argv [expr $i + 1]]
  122.     }
  123.     break
  124. }
  125.     }
  126. }
  127. if {![info exists serverAddress]} {
  128.     set serverAddress 0.0.0.0
  129. }
  131. if {$serverIsSilent == 0} {
  132.     set l "Remote server listening on port $serverPort, IP $serverAddress."
  133.     puts ""
  134.     puts $l
  135.     for {set c [string length $l]} {$c > 0} {incr c -1} {puts -nonewline "-"}
  136.     puts ""
  137.     puts ""
  138.     puts "You have set the Tcl variables serverAddress to $serverAddress and"
  139.     puts "serverPort to $serverPort. You can set these with the -address and"
  140.     puts "-port command line options, or as environment variables in your"
  141.     puts "shell."
  142.     puts ""
  143.     puts "NOTE: The tests will not work properly if serverAddress is set to"
  144.     puts ""localhost" or 127.0.0.1."
  145.     puts ""
  146.     puts "When you invoke tcltest to run the tests, set the variables"
  147.     puts "remoteServerPort to $serverPort and remoteServerIP to"
  148.     puts "[info hostname]. You can set these as environment variables"
  149.     puts "from the shell. The tests will not work properly if you set"
  150.     puts "remoteServerIP to "localhost" or 127.0.0.1."
  151.     puts ""
  152.     puts -nonewline "Type Ctrl-C to terminate--> "
  153.     flush stdout
  154. }
  156. if {[catch {set serverSocket 
  157. [socket -myaddr $serverAddress -server __accept__ $serverPort]} msg]} {
  158.     puts "Server on $serverAddress:$serverPort cannot start: $msg"
  159. } else {
  160.     vwait __server_wait_variable__
  161. }