Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: code/branches/questsystem2/init/common/telnet_server.tcl @ 2676

Last change on this file since 2676 was 1897, checked in by rgrieder, 16 years ago

Added init directory that contains all the files required to run orxonox.
This namely includes plugins.cfg and orxonox.ini in order to set the media path and the plugins correctly.
The solution is not perfect, but a lot better than having all those files in bin/.
We could for instance create an addition special folder for tardis to get rid of plugins.cfg-init, etc.

Also created init/common for files like *.tcl or def_keybindings.ini

Changes in msvc files:
files from init/common and init/SolutionName/ConfigurationName are automatically copied to the output directory if not yet existing.

  • Property svn:eol-style set to native
File size: 7.2 KB
Line 
1 #!/usr/bin/env tclsh
2 # Pseudo-telnet server.  Includes basic auth, but no separate identities
3 # or proper multi-threaded operation, so whoever runs this had better
4 # trust those he gives identities/passwords to and they had better trust
5 # each other too.  Note this script does not support command-line arguments.
6
7 ## The names of this array are IP addresses of hosts that are not permitted
8 ## to connect to any of our services.  Admin account(s) can change this
9 ## at run-time, though this info is not maintained across whole-server shutdowns.
10 array set denyHosts {}
11
12 ## Keep the Tcl-thread busy
13 proc every {ms body} { eval $body; after $ms [list every $ms $body] }
14 every 200 {}
15
16 ## Create a server on the given port with the given name/password map
17 ## and the given core interaction handler.
18 proc telnetServer {port {passmap} {handlerCmd remoteCommand}} {
19     if {$port == 0} {
20         return -code error "Only non-zero port numbers are supported"
21     }
22     set server [socket -server [list connect $port $handlerCmd] $port]
23     global passwords services
24     foreach {id pass} $passmap {set passwords($port,$id) $pass}
25     set services($server) $handlerCmd
26     return $server
27 }
28
29 ## Removes the server on the given port, cleaning up the extra state too.
30 proc closedownServer {server} {
31     global services passwords connections auth
32     set port [lindex [fconfigure $server -sockname] 2]
33     catch {close $server}
34     unset services($server)
35     foreach passmap [array names passwords $port,*] {
36         unset passwords($passmap)
37     }
38     # Hmph!  Have to remove unauthorized connections too, though any
39     # connection which has been authorized can continue safely.
40     foreach {client data} [array get connections] {
41         if {$port == [lindex $data 0] && !$auth($client)} {
42             disconnect $client
43         }
44     }
45 }
46
47 ## Handle an incoming connection to the given server
48 proc connect {serverport handlerCmd client clienthost clientport} {
49     global auth cmd denyHosts connections
50     if {[info exist denyHosts($clienthost)]} {
51         puts stdout "${clienthost}:${clientport} attempted connection"
52         catch {puts $client "Connection denied"}
53         catch {close $client}
54         return
55     }
56     puts stdout "${clienthost}:${clientport} connected on $client"
57     fileevent $client readable "handle $serverport $client"
58     set auth($client) 0
59     set cmd($client) $handlerCmd
60     set connections($client) [list $serverport $clienthost $clientport]
61     fconfigure $client -buffering none
62     catch {puts -nonewline $client "Login: "}
63 }
64
65 ## Disconnect the given client, cleaning up any connection-specific data
66 proc disconnect {client} {
67     catch {close $client}
68     global auth cmd connections
69     unset auth($client)
70     unset cmd($client)
71     unset connections($client)
72     puts stdout "$client disconnected"
73 }
74
75 ## Handle data sent from the client.  Log-in is handled directly by this
76 ## procedure, and requires the name and password on the same line
77 proc handle {serverport client} {
78     global passwords auth cmd
79     if {[gets $client line] < 0} {
80         disconnect $client
81         return
82     }
83     if {[string equal $line "quit"] || [string equal $line "exit"]} {
84         disconnect $client
85         return
86     }
87     if {$auth($client)} {
88         eval $cmd($client) [list $client $line 0]
89         eval $cmd($client) [list $client $line 1]
90         return
91     }
92     foreach {id pass} [split $line] {break}
93     if {![info exist pass]} {
94         catch {puts -nonewline $client "Login: "}
95         return
96     }
97     if {
98         [info exist passwords($serverport,$id)] &&
99         [string equal $passwords($serverport,$id) $pass]
100     } then {
101         set auth($client) 1
102         puts stdout "$id logged in on $client"
103         catch {puts $client "Welcome, $id!"}
104         eval $cmd($client) [list $client $line 1]
105         return
106     }
107     puts stdout "AUTH FAILURE ON $client"
108     catch {puts $client "Unknown name or password"}
109     disconnect $client
110 }
111
112 ## Standard handler for logged-in conversations and prompt-generation.
113 proc execCommand {client line prompt} {
114     global tcl_platform
115     if {$prompt} {
116         catch {puts -nonewline $client "\$ "}
117         return
118     }
119     switch $tcl_platform(platform) {
120         unix {
121             catch {exec sh -c $line <@$client >@$client 2>@$client}
122         }
123         default {
124             catch {exec $line} data
125             puts $client $data
126         }
127     }
128 }
129
130 ## Administration service handler.  Chains to the normal handler for
131 ## everything it doesn't recognise itself.
132 proc admin {client line prompt} {
133     if {$prompt} {
134         catch {puts -nonewline $client "# "}
135         return
136     }
137     set cmd [split $line]
138     global denyHosts connections services
139     if {[string equal $line "shutdown"]} {
140         set ::termination 1
141         puts stdout "Shutdown requested on $client"
142         catch {puts $client "System will shut down as soon as possible"}
143         return -code return "SHUTTING DOWN"
144     } elseif {[string equal [lindex $cmd 0] "deny"]} {
145         set denyHosts([lindex $cmd 1]) 1
146     } elseif {[string equal [lindex $cmd 0] "allow"]} {
147         catch {unset denyHosts([lindex $cmd 1])}
148     } elseif {[string equal $line "denied"]} {
149         foreach host [array names denyHosts] {
150             catch {puts $client $host}
151         }
152     } elseif {[string equal $line "connections"]} {
153         set len 0
154         foreach conn [array names connections] {
155             if {$len < [string length $conn]} {
156                 set len [string length $conn]
157             }
158         }
159         foreach {conn details} [array get connections] {
160             catch {puts $client [format "%-*s = %s" $len $conn $details]}
161         }
162     } elseif {[string equal [lindex $cmd 0] "close"]} {
163         set sock [lindex $cmd 1]
164         if {[info exist connections($sock)]} {
165             disconnect $sock
166         }
167     } elseif {[string equal $line "services"]} {
168         set len 0
169         foreach serv [array names services] {
170             if {$len < [string length $serv]} {
171                 set len [string length $serv]
172             }
173         }
174         foreach {serv handler} [array get services] {
175             set port [lindex [fconfigure $serv -sockname] 2]
176             catch {puts $client [format "%-*s (port %d) = handler %s" $len $serv $port $handler]}
177         }
178     } elseif {[string equal [lindex $cmd 0] "addService"]} {
179         set service [eval telnetServer [lrange $cmd 1 end]]
180         catch {puts $client "Created service as $service"}
181     } elseif {[string equal [lindex $cmd 0] "removeService"]} {
182         set service [lindex $cmd 1]
183         if {[info exist services($service)]} {
184             closedownServer $service
185         }
186     } else {
187         # CHAIN TO DEFAULT
188         execCommand $client $line 0
189     }
190 }
191 
192 ## Executes a given command
193 proc remoteCommand {client line prompt} {
194     global tcl_platform
195     if {$prompt} {
196         catch {puts -nonewline $client "\$ "}
197         return
198     }
199     catch {eval $line} data
200     puts $client $data
201 }
202
203 telnetServer 2560 {orxonox rocks} remoteCommand
204 telnetServer 2561 {orxadmin *****} admin
205
206 puts stdout "Ready for service"
207
208 vwait termination
209 execute exit
Note: See TracBrowser for help on using the repository browser.