70 lines
2.1 KiB
Tcl
70 lines
2.1 KiB
Tcl
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
|
|
|
|
# Creates a socket server which listens for connections and accepts commands
|
|
# from DMC2280 clients (eg SICS).
|
|
proc serverOpen {channel addr port} {
|
|
global connected
|
|
set connected 1
|
|
fileevent $channel readable "readLine Server $channel"
|
|
puts "OPENED"
|
|
return;
|
|
}
|
|
|
|
# Reads a command from a DMC2280 client and then performs an appropriate
|
|
# action depending on whether or not the command produces output or has
|
|
# been defined.
|
|
proc readLine {who channel} {
|
|
global didRead
|
|
global B
|
|
if {[gets $channel line]<0} {
|
|
fileevent $channel readable {}
|
|
after idle "close $channel;set out 1"
|
|
} else {
|
|
puts "RECEIVED: $line"
|
|
|
|
foreach cmd [split $line ";"] {
|
|
switch -glob $cmd {
|
|
"" {puts -nonewline $channel ":"}
|
|
"kill" {exit}
|
|
"SH*" - "BG*" - "PA*" - "PR*" - "JG*" - "DP*" - "AT*" - "MO*" - "ST*" - "SP*" - "AC*" - "DC*" {
|
|
eval [parse $cmd]
|
|
puts -nonewline $channel ":"
|
|
}
|
|
"TP*" - "TD*" - "TI*" - "XQ*" {
|
|
set output [eval [parse $cmd]]
|
|
puts $channel " $output"; puts -nonewline $channel ":"
|
|
}
|
|
"LV" {
|
|
set output [eval [parse $cmd]]
|
|
puts $channel "$output"; puts -nonewline $channel ":"
|
|
}
|
|
"TS*" {
|
|
set output [eval [parse $cmd]]
|
|
puts $channel " $output"; puts -nonewline $channel ":"
|
|
}
|
|
"TC 1" {
|
|
puts $channel " DMC2280 ERROR"; puts -nonewline $channel ":"
|
|
}
|
|
"MG *" {
|
|
set output [eval [parse $cmd]]
|
|
puts $channel " $output"; puts -nonewline $channel ":"
|
|
}
|
|
}
|
|
flush $channel;
|
|
}
|
|
set didRead 1
|
|
}
|
|
return;
|
|
}
|
|
|
|
# startserver -port 1034
|
|
proc startserver {args} {
|
|
global tcl_interactive;
|
|
array set parr $args;
|
|
set connected 0;
|
|
set server [socket -server serverOpen $parr(-port)];
|
|
after 100 update;
|
|
if {$tcl_interactive==0} {vwait forever }
|
|
return;
|
|
}
|