author | A.M. Thurnherr <ant@ldeo.columbia.edu> |
Fri, 07 Jan 2011 23:25:51 +0000 | |
changeset 10 | 5873914adea7 |
parent 5 | f41d45fe7ae9 |
child 12 | 5e67754f6457 |
permissions | -rwxr-xr-x |
0 | 1 |
#!/usr/bin/perl |
2 |
#====================================================================== |
|
3 |
# B B A B B L E |
|
4 |
# doc: Thu Mar 11 01:00:51 2004 |
|
5 | 5 |
# dlm: Wed Dec 1 14:31:14 2010 |
0 | 6 |
# (c) 2004 A.M. Thurnherr |
5 | 7 |
# uE-Info: 49 73 NIL 0 0 72 10 2 8 NIL ofnI |
0 | 8 |
#====================================================================== |
9 |
||
10 |
# Broad Band Babble --- talk to 1--2 RDI ADCPs |
|
11 |
||
12 |
# HISTORY: |
|
13 |
# Mar 5, 2004: - written first, one-page-long proof-of-concept version |
|
14 |
# Mar 6, 2004: - added downloading |
|
15 |
# Mar 7, 2004: - made it portable (linux & MacOSX) |
|
16 |
# Mar 8, 2004: - made stdin rawmode |
|
17 |
# - colorized |
|
18 |
# Mar 9, 2004: - added support for 2nd instrument |
|
19 |
# - allowed for high-speed wire crosstalk (disallow BREAK |
|
20 |
# while download is going on) |
|
21 |
# Mar 10, 2004: - added -m)onochrome to aid expect(1) |
|
22 |
# Mar 11, 2004: - made fully compatible with expect(1) by adding -s |
|
23 |
# (disable asyncronous messages) |
|
24 |
# Mar 12, 2004: - various improvements |
|
25 |
# Mar 18, 2004: - re-added async download errmesg on failed downloads |
|
26 |
# to allow aborting 2nd download if one fails |
|
27 |
# Mar 21, 2004: - added proper syncronization for download (waiting for |
|
28 |
# instrument to tell us to start the host) |
|
29 |
# Apr 4, 2004: - added comments |
|
30 |
# Jun 14, 2004: - added port-open delay for KESPAN 49W multiport adapter |
|
31 |
# - BB150 requires \r after commands instead of \n |
|
32 |
# - added support for lack of ymodem prompt of BB150 |
|
33 |
# Jan 19, 2006: - added code to determine whether ymodem receiver is |
|
34 |
# called rb or lrb |
|
35 |
# Jan 25, 2006: - removed default download prompt |
|
36 |
# - re-directed stderr of `which lrb` because of linux |
|
37 |
# Aug 7, 2006: - added ^U(pload) capability on L'Atalante (DYNAMUCK) |
|
38 |
# - BUG: length of $DOWNLOAD_SPEED_RDI_COMMAND was hardcoded |
|
39 |
# - BUG: $START_DOWNLOAD_RDI_COMMAND was hardcoded |
|
40 |
# - BUG: FreeBSD needs a nap between writing baudrate- |
|
41 |
# change command & setattr() |
|
42 |
# Aug 8, 2006: - added support for $PROGRAMMING_SPEED_TERMIOS_CONST |
|
43 |
# Aug 28, 2006: - updated doc |
|
44 |
# Nov 14, 2006: - added ^B (baud-rate handling) |
|
45 |
# - changes to task syncronization |
|
46 |
# - replace unprintable chars by ? while in ECHO mode (only!) |
|
4
fda11de1826e
version left on Poseidon at end of P403
A.M. Thurnherr <ant@ldeo.columbia.edu>
parents:
0
diff
changeset
|
47 |
# Aug 26, 2010: - added -y)modem receive |
5 | 48 |
# Oct 18, 2010: - added -u option to default ymodem receive call |
49 |
# Dec 1, 2010: - BUG: -y with empty-string option argument did not work |
|
0 | 50 |
|
51 |
#---------------------------------------------------------------------- |
|
52 |
# USAGE |
|
53 |
#---------------------------------------------------------------------- |
|
54 |
||
4
fda11de1826e
version left on Poseidon at end of P403
A.M. Thurnherr <ant@ldeo.columbia.edu>
parents:
0
diff
changeset
|
55 |
use Getopt::Std; |
fda11de1826e
version left on Poseidon at end of P403
A.M. Thurnherr <ant@ldeo.columbia.edu>
parents:
0
diff
changeset
|
56 |
|
fda11de1826e
version left on Poseidon at end of P403
A.M. Thurnherr <ant@ldeo.columbia.edu>
parents:
0
diff
changeset
|
57 |
$USAGE = "Usage: $0 [-m)onochrome] [-s)uppress async output] " . |
fda11de1826e
version left on Poseidon at end of P403
A.M. Thurnherr <ant@ldeo.columbia.edu>
parents:
0
diff
changeset
|
58 |
"[-y)modem receive <cmd>] " . |
fda11de1826e
version left on Poseidon at end of P403
A.M. Thurnherr <ant@ldeo.columbia.edu>
parents:
0
diff
changeset
|
59 |
"<tty0_device> [tty1_device]\n"; |
fda11de1826e
version left on Poseidon at end of P403
A.M. Thurnherr <ant@ldeo.columbia.edu>
parents:
0
diff
changeset
|
60 |
|
fda11de1826e
version left on Poseidon at end of P403
A.M. Thurnherr <ant@ldeo.columbia.edu>
parents:
0
diff
changeset
|
61 |
die($USAGE) unless (getopts("msy:")); |
0 | 62 |
|
63 |
# bbabble is started with 1 or 2 arguments, which are tty special files. |
|
64 |
# On LINUX, /dev/ttyS0 is com1: /dev/ttyS1 is com2: /dev/ttyUSB0 is the |
|
65 |
# first USB tty port, /dev/ttyUSB1 is the 2nd, &c. If two ttys are |
|
66 |
# specified bbabble can talk to two instruments in parallel. Communication |
|
67 |
# with The first (second) port is shown in red (blue). For consistency |
|
68 |
# with the color scheme used by the LDEO expect scripts, the master |
|
69 |
# (downlooker) should be connected to the first tty given on the command |
|
70 |
# line. |
|
71 |
||
72 |
# On some (especially BSD-based) systems there are separate tty |
|
73 |
# device files for dialin and dialout operations. Only the latter work |
|
74 |
# with bbabble. They traditionally have names matching /dev/cu* (e.g. |
|
75 |
# /dev/cuad0 for the first serial # port in FreeBSD). |
|
76 |
||
77 |
# In order to have read/write access to the device files, the user |
|
78 |
# that is to run bbabble should be added to the group that owns |
|
79 |
# the tty device files (e.g. dialer on FreeBSD). |
|
80 |
||
81 |
# The -m option suppresses color ouput and -s suppresses the asynchronous |
|
82 |
# messages generated by bbabble and printed in curly braces. Both |
|
83 |
# options should be used if bbabble is run within expect(1). |
|
84 |
||
85 |
# Upon startup, bbabble prints a help message showing the current |
|
86 |
# "foreground" instrument as well as a list of legal keyboard commands. |
|
87 |
# These should be largely self explanatory. Initially, bbabble |
|
88 |
# is set up to talk to the instrument connected to the first tty. When |
|
89 |
# 2 ttys are given on the command line, ^T (ctrl-T) can be used to toggle |
|
90 |
# between the instruments --- ^T is not available if only one tty is |
|
91 |
# given on the command line. |
|
92 |
||
93 |
# When bbabble talks to two instrument, the output from the "background" |
|
94 |
# instrument is buffered internally. When ^T is pressed all buffered output |
|
95 |
# is flushed to the screen. |
|
96 |
||
97 |
# ^C sends a BREAK to the currently active instrument, but only if neither |
|
98 |
# of the instruments is currently downloading. If the "foreground" instrument |
|
99 |
# is downloading, ^C aborts the download. If the "background" instrument is |
|
100 |
# downloading an error message is produced but no BREAK is sent. (This |
|
101 |
# behaviour is necessariy because it was found that a BREAK sent to the |
|
102 |
# "foreground" instrument somtimes aborts a high-speed download in progress |
|
103 |
# from the "background" instrument. Perhaps this is only the case with |
|
104 |
# LDEO cabling with shared ground. |
|
105 |
||
106 |
# ^X starts a high-speed download from the "foreground" instrument. |
|
107 |
# Once the download has been started, the "background" instrument can be |
|
108 |
# brought into the foreground with ^T in order to start a parallel download |
|
109 |
# or the user can escape to the shell using ^S. In any case, asyncronous |
|
110 |
# messages are printed (in the corresponding color) whenever one of the two |
|
111 |
# instruments has finished the download (except when -s is used to suppress |
|
112 |
# asynchronous messages). |
|
113 |
||
114 |
# On ^U the user is asked for a command-file-name to be uploaded to the |
|
115 |
# instrument. The command file may contain any valid RDI command, empty |
|
116 |
# lines, as well as comments beginning with a semicolon (;). |
|
117 |
||
118 |
# Upon startup, bbabble expects to communicate with the ADCPs at 9600bps |
|
119 |
# (baud). If the user sends a BREAK (^C) and garbage is produced the |
|
120 |
# instrument's default baud rate is probably set to a different value. |
|
121 |
# ^B cycles through all available instrument baud rates by first sending |
|
122 |
# the corresponding command (e.g. CB411) to the instrument and then |
|
123 |
# changing the TTY line characteristics. With this scheme it should be |
|
124 |
# possible to reset the default baudrate of the instrument by executing |
|
125 |
# the following steps: |
|
126 |
# 1. start bbabble |
|
127 |
# 2. type ^C to wake the instrument |
|
128 |
# 3. type ^B nine times (wait a couple of seconds between keystrokes) |
|
129 |
# 4. issue the command "CK" to save the current baudrate as default |
|
130 |
# 5. issue the command "CZ" to send the instrument to sleep |
|
131 |
# 6. type ^D to exit bbabble |
|
132 |
||
133 |
#---------------------------------------------------------------------- |
|
134 |
# IMPLEMENTATION NOTES |
|
135 |
#---------------------------------------------------------------------- |
|
136 |
||
137 |
# DOWNLOAD BAUD RATE |
|
138 |
# Most of the communication is carried out at the default baud rate |
|
139 |
# (initially set to 9600baud, but can be changed with ^B). For |
|
140 |
# downloading the communications speed is increased to 115kbps. The |
|
141 |
# baud rate is dropped to the default on the next BREAK. Unfortunately, |
|
142 |
# the POSIX standard only deals with baud rates up to 38400 bps. Therefore, |
|
143 |
# I had to implement a failry dreadful hack using a call to the c |
|
144 |
# preprocessor to determine the correct argument to set higher |
|
145 |
# baud rates. This works only if gcc is installed... |
|
146 |
# |
|
147 |
# NOTE: After a download has completed the instrument stays in |
|
148 |
# high-speed mode. When the current parameters are stored in |
|
149 |
# non-volatile memory (CK command) at this stage the instrument's |
|
150 |
# default speed is 115kbps and has to be reset explicitly. |
|
151 |
||
152 |
# OTHER COMMUNICATIONS PARAMETERS |
|
153 |
# bbabble assumes the ADCPs to use no parity, 8 data bits and 1 stop bit. |
|
154 |
# Other parameters require changes to bbabble. |
|
155 |
||
156 |
# THREADS |
|
157 |
# Writing a dumb terminal with threads is dead easy: one thread reads |
|
158 |
# from the keyboard and writes to the serial device and another reads |
|
159 |
# from the serial devices and writes to the screen. A first version |
|
160 |
# of bbabble was less than 50 lines of perl code. The current version |
|
161 |
# is much longer because the threads must synchronize. This is accomplished |
|
162 |
# by the tty-reader threads (one per active tty) being implemented as |
|
163 |
# finite-state automata. The tty-writer (or keyboard-reader) thread |
|
164 |
# sends commands to the tty-readers by changing the corresponding global |
|
165 |
# state # variable and waiting for a response-change in the same |
|
166 |
# variable. |
|
167 |
# NB: bbabble NEEDS A THREADED VERSION OF PERL. DEFAULT VERSIONS, E.G. |
|
168 |
# ON MACOSX ARE NOT THREADED! |
|
169 |
||
170 |
#---------------------------------------------------------------------- |
|
171 |
# TWEAKABLES |
|
172 |
#---------------------------------------------------------------------- |
|
173 |
||
174 |
# The following defines the command sent to the ADCP to start |
|
175 |
# downloading. (NB: RY0 is more portable than RY, which does not work |
|
176 |
# for BB150 instruments) |
|
177 |
||
178 |
$START_DOWNLOAD_RDI_COMMAND = 'RY0'; |
|
179 |
||
180 |
# After a download is initiated with the RY0 command, WorkHorses |
|
181 |
# send a prompt, telling the user to start downloading, while BB150 do not. |
|
182 |
# Set the following variables to the prompt returned by the instrument. |
|
183 |
# An empty string means that no prompt is expected, but a gratuitous |
|
184 |
# pause of 1s is inserted instead, just in case. This is now made the default, |
|
185 |
# because is it more portable. |
|
186 |
||
187 |
#$ymodem_download_prompt[0] = 'Please start your host now'; |
|
188 |
#$ymodem_download_prompt[1] = 'Please start your host now'; |
|
189 |
||
190 |
$ymodem_download_prompt[0] = ''; |
|
191 |
$ymodem_download_prompt[1] = ''; |
|
192 |
||
193 |
# Downloading should be done at the highest possible speed. 115200 bps has |
|
194 |
# always worked well for me, with a variety of ADCP heads and acquisition |
|
195 |
# computers. |
|
196 |
||
197 |
#$DOWNLOAD_SPEED = 9600; |
|
198 |
#$DOWNLOAD_SPEED = 38400; |
|
199 |
#$DOWNLOAD_SPEED = 57600; |
|
200 |
$DOWNLOAD_SPEED = 115200; |
|
201 |
||
202 |
# I prefer communicating at 9600 bps, except when downloading. |
|
203 |
# Other users prefer faster speeds, and the following variable allows |
|
204 |
# selecting the default speed. Note that it must be consistent with the |
|
205 |
# speed saved in the user settings of the ADCP (last CK command). |
|
206 |
||
207 |
my(@DEFAULT_SPEED):shared; |
|
208 |
my(@COMMS_SPEED):shared; |
|
209 |
||
210 |
$DEFAULT_SPEED[0] = 9600; |
|
211 |
$DEFAULT_SPEED[1] = 9600; |
|
212 |
||
213 |
# bbabble allows an escape to the shell, for example during downloading. |
|
214 |
# You can chose which shell it uses. If you chose anything but /bin/ksh |
|
215 |
# you obviously don't know what you're doing. Linux does not come with |
|
216 |
# /bin/ksh by default. They obviously don't know what they're doing. |
|
217 |
||
218 |
$shell = '/bin/sh'; |
|
219 |
||
220 |
# Synchronization between the threads is accomplished using spin locks. |
|
221 |
# The $naptime variable determines how fast the locks spin and determine |
|
222 |
# the maximum response time in seconds. |
|
223 |
||
224 |
$naptime = 0.1; # nap time in seconds |
|
225 |
||
226 |
# If after $timeout seconds thread syncronization has not been achieved, |
|
227 |
# a timeout error is generated. |
|
228 |
||
229 |
$timeout = 10; # timeout waiting for instrument |
|
230 |
||
231 |
# The following are the tput(1) colors. They should be set to the standard |
|
232 |
# text color (black), red and blue, respectively. To test them, simply type |
|
233 |
# `tput setaf 1', and you should get red text on whatever background |
|
234 |
# was previously selected. |
|
235 |
||
236 |
$COLOR_RESET = 0; |
|
237 |
$COLOR_TTY0 = 1; |
|
238 |
$COLOR_TTY1 = 4; |
|
239 |
||
240 |
# RDI instruments use the ymodem protocol to transfer files. There is |
|
241 |
# a public-domain version of ymodem that works very well. Depending on |
|
242 |
# the UNIX version, the ymodem-receiver can be called `rb' or `lrb'. |
|
243 |
# It does not have its own manpage but is described in the man page of |
|
244 |
# `rz' (the zmodem receiver). To make matters worse, In the man page |
|
245 |
# the prgram is always called `rb', even on systems where the executable |
|
4
fda11de1826e
version left on Poseidon at end of P403
A.M. Thurnherr <ant@ldeo.columbia.edu>
parents:
0
diff
changeset
|
246 |
# is `lrb'. |
fda11de1826e
version left on Poseidon at end of P403
A.M. Thurnherr <ant@ldeo.columbia.edu>
parents:
0
diff
changeset
|
247 |
# If -y is not given, bbabble trys to find one of the standard ymodem |
fda11de1826e
version left on Poseidon at end of P403
A.M. Thurnherr <ant@ldeo.columbia.edu>
parents:
0
diff
changeset
|
248 |
# executables. Using -y allows options to be set. |
0 | 249 |
|
5 | 250 |
if (length($opt_y) > 0) { |
4
fda11de1826e
version left on Poseidon at end of P403
A.M. Thurnherr <ant@ldeo.columbia.edu>
parents:
0
diff
changeset
|
251 |
$receive_ymodem = $opt_y; |
fda11de1826e
version left on Poseidon at end of P403
A.M. Thurnherr <ant@ldeo.columbia.edu>
parents:
0
diff
changeset
|
252 |
} else { |
fda11de1826e
version left on Poseidon at end of P403
A.M. Thurnherr <ant@ldeo.columbia.edu>
parents:
0
diff
changeset
|
253 |
chomp($receive_ymodem = `which lrb 2>/dev/null`); |
fda11de1826e
version left on Poseidon at end of P403
A.M. Thurnherr <ant@ldeo.columbia.edu>
parents:
0
diff
changeset
|
254 |
chomp($receive_ymodem = `which rb 2>/dev/null`) |
fda11de1826e
version left on Poseidon at end of P403
A.M. Thurnherr <ant@ldeo.columbia.edu>
parents:
0
diff
changeset
|
255 |
if ($receive_ymodem eq ''); |
fda11de1826e
version left on Poseidon at end of P403
A.M. Thurnherr <ant@ldeo.columbia.edu>
parents:
0
diff
changeset
|
256 |
die("$0: cannot find rb or lrb\n") |
fda11de1826e
version left on Poseidon at end of P403
A.M. Thurnherr <ant@ldeo.columbia.edu>
parents:
0
diff
changeset
|
257 |
if ($receive_ymodem eq ''); |
5 | 258 |
$receive_ymodem .= ' -u'; # keep upper-case filenames |
4
fda11de1826e
version left on Poseidon at end of P403
A.M. Thurnherr <ant@ldeo.columbia.edu>
parents:
0
diff
changeset
|
259 |
} |
0 | 260 |
|
261 |
# When uploading command files, each command is sent after a prompt |
|
262 |
# is received from the instrument. The following variable defines the |
|
263 |
# prompt (as a perl regexpr). ANCHOR AT END ONLY!!! |
|
264 |
||
265 |
$RDI_prompt = '>$'; |
|
266 |
||
267 |
#====================================================================== |
|
268 |
# PROGRAM |
|
269 |
#====================================================================== |
|
270 |
||
271 |
use threads; |
|
272 |
use threads::shared; |
|
273 |
use IO::Handle; |
|
274 |
use POSIX (); |
|
275 |
||
276 |
if (scalar(@ARGV) == 1) { |
|
277 |
$TTY0 = $ARGV[0]; |
|
278 |
} elsif (scalar(@ARGV) == 2) { |
|
279 |
$TTY0 = $ARGV[0]; |
|
280 |
$TTY1 = $ARGV[1]; |
|
281 |
} else { |
|
282 |
die($USAGE); |
|
283 |
} |
|
284 |
||
285 |
#---------------------------------------------------------------------- |
|
286 |
# determine baudrate tcsetospeed() arguments |
|
287 |
#---------------------------------------------------------------------- |
|
288 |
||
289 |
$TERMIOS_SPEED{300} = &POSIX::B300; $RDI_SPEED{300} = 'CB0'; |
|
290 |
$TERMIOS_SPEED{1200} = &POSIX::B1200; $RDI_SPEED{1200} = 'CB1'; |
|
291 |
$TERMIOS_SPEED{2400} = &POSIX::B2400; $RDI_SPEED{2400} = 'CB2'; |
|
292 |
$TERMIOS_SPEED{4800} = &POSIX::B4800; $RDI_SPEED{4800} = 'CB3'; |
|
293 |
$TERMIOS_SPEED{9600} = &POSIX::B9600; $RDI_SPEED{9600} = 'CB4'; |
|
294 |
$TERMIOS_SPEED{19200} = &POSIX::B19200; $RDI_SPEED{19200} = 'CB5'; |
|
295 |
$TERMIOS_SPEED{38400} = &POSIX::B38400; $RDI_SPEED{38400} = 'CB6'; |
|
296 |
$RDI_SPEED{57600} = 'CB7'; |
|
297 |
$RDI_SPEED{57600} = 'CB7'; |
|
298 |
$RDI_SPEED{115200} = 'CB8'; |
|
299 |
||
300 |
# The following is ugly & slow, but seems fairly portable. |
|
301 |
||
302 |
open(TMP,'>/tmp/tt.c'); print(TMP "#include <termios.h>\nB57600\n"); |
|
303 |
close(TMP); |
|
304 |
$TERMIOS_SPEED{57600} = `gcc -E /tmp/tt.c | tail -1`; |
|
305 |
$TERMIOS_SPEED{57600} = hex($TERMIOS_SPEED{57600}) |
|
306 |
if ($TERMIOS_SPEED{57600} =~ /^0x/); |
|
307 |
$TERMIOS_SPEED{57600} = oct($TERMIOS_SPEED{57600}) |
|
308 |
if ($TERMIOS_SPEED{57600} =~ /^0/); |
|
309 |
||
310 |
open(TMP,'>/tmp/tt.c'); print(TMP "#include <termios.h>\nB115200\n"); |
|
311 |
close(TMP); |
|
312 |
$TERMIOS_SPEED{115200} = `gcc -E /tmp/tt.c | tail -1`; |
|
313 |
$TERMIOS_SPEED{115200} = hex($TERMIOS_SPEED{115200}) |
|
314 |
if ($TERMIOS_SPEED{115200} =~ /^0x/); |
|
315 |
$TERMIOS_SPEED{115200} = oct($TERMIOS_SPEED{115200}) |
|
316 |
if ($TERMIOS_SPEED{115200} =~ /^0/); |
|
317 |
unlink('/tmp/tt.c'); |
|
318 |
||
319 |
#---------------------------------------------------------------------- |
|
320 |
# Common Setup |
|
321 |
#---------------------------------------------------------------------- |
|
322 |
||
323 |
$COMMS_SPEED[0] = $DEFAULT_SPEED[0]; # baud rates |
|
324 |
$COMMS_SPEED[1] = $DEFAULT_SPEED[1]; |
|
325 |
||
326 |
unless ($opt_m) { # colors |
|
327 |
$RESET = `tput setaf $COLOR_RESET`; |
|
328 |
@COLOR = (`tput setaf $COLOR_TTY0` , |
|
329 |
`tput setaf $COLOR_TTY1`); |
|
330 |
} |
|
331 |
||
332 |
my(@sfd); # TTYs |
|
333 |
open(TTY0,'+>',$TTY0) || die("$TTY0: $!\n"); |
|
334 |
$sfd[0] = fileno(TTY0); |
|
335 |
if (defined($TTY1)) { |
|
336 |
select(undef,undef,undef,$naptime); # KEYSPAN 49W requires this |
|
337 |
open(TTY1,'+>',$TTY1) || die("$TTY1: $!\n"); |
|
338 |
$sfd[1] = fileno(TTY1); |
|
339 |
} |
|
340 |
||
341 |
STDOUT->autoflush(1); # flushing |
|
342 |
STDERR->autoflush(1); |
|
343 |
||
344 |
#---------------------------------------------------------------------- |
|
345 |
# TTY-Reader Threads |
|
346 |
#---------------------------------------------------------------------- |
|
347 |
||
348 |
# valid states of the receiver FSA; NB: DOWNLOAD can be combined with |
|
349 |
# BUFFER and ECHO; SET_DEFAULT_SPEED (used during BREAK) can be combined |
|
350 |
# with UPLOAD & ECHO (w or w/o DOWNLOAD). |
|
351 |
||
352 |
my($SHUTDOWN):shared = 0x00; # terminate |
|
353 |
my($ECHO):shared = 0x01; # normal state of active instrument |
|
354 |
my($BUFFER):shared = 0x02; # normal state of inactive instrument |
|
355 |
my($FLUSH):shared = 0x04; # flush buffered data |
|
356 |
my($SET_DOWNLOAD_SPEED):shared= 0x10; # change baudrate |
|
357 |
my($SET_DEFAULT_SPEED):shared = 0x20; # change baudrate |
|
358 |
my($UPLOAD):shared = 0x40; # upload cmd file |
|
359 |
my($DOWNLOAD):shared = 0x80; # download (using ymodem) |
|
360 |
||
361 |
my(@rcv_state):shared = ($ECHO,$BUFFER); # initial states |
|
362 |
my(@dld_pid):shared; # downloader pids |
|
363 |
||
364 |
sub TTY_receiver($) |
|
365 |
{ |
|
366 |
my($id) = @_; |
|
367 |
||
368 |
my($t) = POSIX::Termios::new(); # setup serial line |
|
369 |
print(STDERR "$COLOR[$id]tcgetattr: $!\n"),return # ... N81 |
|
370 |
unless defined($t->getattr($sfd[$id])); |
|
371 |
$t->setiflag($t->getiflag() & ~(POSIX::IGNBRK() | |
|
372 |
POSIX::BRKINT() | |
|
373 |
POSIX::PARMRK() | |
|
374 |
POSIX::ISTRIP() | |
|
375 |
POSIX::INLCR() | |
|
376 |
POSIX::IGNCR() | |
|
377 |
POSIX::ICRNL() | |
|
378 |
POSIX::IXON())); |
|
379 |
$t->setoflag($t->getoflag() & ~POSIX::OPOST()); |
|
380 |
$t->setlflag($t->getlflag() & ~(POSIX::ECHO() | |
|
381 |
POSIX::ECHONL() | |
|
382 |
POSIX::ICANON() | |
|
383 |
POSIX::ISIG() | |
|
384 |
POSIX::IEXTEN())); |
|
385 |
$t->setcflag($t->getcflag() & ~(POSIX::CSIZE()|POSIX::PARENB()) |
|
386 |
| POSIX::CS8()); |
|
387 |
$t->setcc(POSIX::VMIN,1); $t->setcc(POSIX::VTIME,0); |
|
388 |
set_speed($t,$id,$DEFAULT_SPEED[$id]); |
|
389 |
if ($opt_s) { |
|
390 |
print($COLOR[$id]) unless ($opt_m); |
|
391 |
print("{TTY $id READY}"); |
|
392 |
} |
|
393 |
||
394 |
my(@buf,$rin); |
|
395 |
my($nbi) = 0; # next buffer |
|
396 |
||
397 |
while (1) { # reader loop |
|
398 |
vec($rin,$sfd[$id],1) = 1; |
|
399 |
while (!select($rin,undef,undef,$naptime)) { # wait for data |
|
400 |
return unless ($rcv_state[$id]); # ... or state change |
|
401 |
last unless ($rcv_state[$id] == $ECHO || |
|
402 |
$rcv_state[$id] == $BUFFER); |
|
403 |
vec($rin,$sfd[$id],1) = 1; |
|
404 |
} |
|
405 |
||
406 |
#------------------------------ |
|
407 |
# DOWNLOAD DATA FROM INSTRUMENT |
|
408 |
#------------------------------ |
|
409 |
||
410 |
if ($rcv_state[$id] == $DOWNLOAD) { # initiate download |
|
411 |
if ($ymodem_download_prompt[$id] eq '') { # no prompt from instrument |
|
412 |
sleep(1); |
|
413 |
} else { |
|
414 |
my($buf,$msg,$nread); # wait for RDI prompt |
|
415 |
print(STDERR "$COLOR[$id]\{WAITING FOR RDI DOWNLOAD PROMPT}\n") |
|
416 |
unless ($opt_s); |
|
417 |
do { |
|
418 |
$nread = POSIX::read($sfd[$id],$buf,64); |
|
419 |
die("$COLOR[$id]read: EOF\n") if ($nread == 0); |
|
420 |
die("$COLOR[$id]read: $!\n") if ($nread < 0); |
|
421 |
POSIX::write(1,$buf,$nread); |
|
422 |
$msg = unpack("a$nread",$buf); |
|
423 |
} until ($msg =~ /$ymodem_download_prompt[$id]/); |
|
424 |
} |
|
425 |
||
426 |
print(STDERR "$COLOR[$id]\{STARTING DOWNLOAD}\n") # start ymodem receiver |
|
427 |
unless ($opt_s); |
|
428 |
my($rfd,$wfd) = POSIX::pipe(); |
|
429 |
$dld_pid[$id] = fork(); |
|
430 |
if ($dld_pid[$id] == 0) { |
|
431 |
POSIX::dup2($sfd[$id],0); |
|
432 |
POSIX::dup2($sfd[$id],1); |
|
433 |
POSIX::dup2($wfd,2); |
|
434 |
POSIX::close($rfd); POSIX::close($wfd); |
|
435 |
exec($receive_ymodem); |
|
436 |
die("$COLOR[$id]exec: $!$RESET\n"); |
|
437 |
} |
|
438 |
||
439 |
POSIX::close($wfd); # handle progress data |
|
440 |
while (1) { |
|
441 |
my($buf,$nread); |
|
442 |
$nread = POSIX::read($rfd,$buf,64); |
|
443 |
$rcv_state[$id] |= $ECHO # initially, echo tty |
|
444 |
if ($rcv_state[$id] == $DOWNLOAD); |
|
445 |
last if ($nread == 0); # EOF => ymodem done |
|
446 |
if ($rcv_state[$id]&$BUFFER) { # buffer data |
|
447 |
$nread[$nbi] = $nread; |
|
448 |
$buf[$nbi++] = $buf; |
|
449 |
} elsif ($rcv_state[$id]&$FLUSH) { # flush buffered data |
|
450 |
print($COLOR[$id]) unless ($opt_s); |
|
451 |
for (my($bi)=0; $bi<$nbi; $bi++) { |
|
452 |
my($buf) = $buf[$bi]; |
|
453 |
my($nread) = $nread[$bi]; |
|
454 |
POSIX::write(1,$buf,$nread); |
|
455 |
} |
|
456 |
$nbi = 0; |
|
457 |
$rcv_state[$id] = $DOWNLOAD|$ECHO; # now, continue echoing |
|
458 |
POSIX::write(1,$buf,$nread); # don't forget! |
|
459 |
} else { # echo data |
|
460 |
print($COLOR[$id]) unless ($opt_s); |
|
461 |
POSIX::write(1,$buf,$nread); |
|
462 |
} |
|
463 |
} |
|
464 |
POSIX::close($rfd); |
|
465 |
||
466 |
my($rip) = waitpid($dld_pid[$id],0); # ymodem has finished |
|
467 |
print(STDERR "$COLOR[$id]waitpid($dld_pid[$id]->$rip: $!\n"),return |
|
468 |
unless ($rip == $dld_pid[$id]); |
|
469 |
if (POSIX::WIFEXITED($?)) { # check exit status |
|
470 |
if (POSIX::WEXITSTATUS($?)) { # error |
|
471 |
print(STDERR $COLOR[$id]) unless ($opt_m); |
|
472 |
printf(STDERR "{DOWNLOAD EXITED ABNORMALLY --- STATUS %d}$RESET", |
|
473 |
POSIX::WEXITSTATUS($?)); |
|
474 |
} else { # no error |
|
475 |
print(STDERR "$COLOR[$id]\{DOWNLOAD INSTRUMENT $id OK}\n$RESET") |
|
476 |
unless ($opt_s); |
|
477 |
} |
|
478 |
} elsif (POSIX::WIFSIGNALED($?)) { # killed by signal |
|
479 |
print(STDERR $COLOR[$id]) unless ($opt_m); |
|
480 |
printf(STDERR "{DOWNLOAD KILLED BY SIGNAL %d}$RESET", |
|
481 |
POSIX::WTERMSIG($?)); |
|
482 |
} else { # should not happen! |
|
483 |
print(STDERR $COLOR[$id]) unless ($opt_m); |
|
484 |
printf(STDERR "{UNKNOWN DOWNLOAD TERMINATION --- STATUS %d}$RESET",$?); |
|
485 |
} |
|
486 |
$rcv_state[$id] &= ~$DOWNLOAD; # acknowledge operation |
|
487 |
} |
|
488 |
||
489 |
#------------------------------ |
|
490 |
# SET DOWNLOAD BAUD RATE |
|
491 |
#------------------------------ |
|
492 |
||
493 |
elsif ($rcv_state[$id] == $SET_DOWNLOAD_SPEED) { |
|
494 |
print(STDERR "$COLOR[$id]\{SETTING DOWNLOAD SPEED}") unless ($opt_s); |
|
495 |
POSIX::write($sfd[$id],"$RDI_SPEED{$DOWNLOAD_SPEED}11\r",6); |
|
496 |
select(undef,undef,undef,$naptime); |
|
497 |
set_speed($t,$id,$DOWNLOAD_SPEED); |
|
498 |
$rcv_state[$id] = $ECHO; # acknowledge operation |
|
499 |
} |
|
500 |
||
501 |
#------------------------------ |
|
502 |
# SET NORMAL BAUD RATE |
|
503 |
#------------------------------ |
|
504 |
||
505 |
elsif ($rcv_state[$id]&$SET_DEFAULT_SPEED) { |
|
506 |
print(STDERR "$COLOR[$id]\{SETTING DEFAULT SPEED}") unless ($opt_s); |
|
507 |
set_speed($t,$id,$DEFAULT_SPEED[$id]); |
|
508 |
$rcv_state[$id] &= ~$SET_DEFAULT_SPEED; # acknowledge operation |
|
509 |
} |
|
510 |
||
511 |
#----------------------------------- |
|
512 |
# INACTIVE INSTRUMENT => BUFFER DATA |
|
513 |
#----------------------------------- |
|
514 |
||
515 |
elsif ($rcv_state[$id] == $BUFFER) { |
|
516 |
my($buf,$nread); |
|
517 |
$nread = POSIX::read($sfd[$id],$buf,64); |
|
518 |
$nread[$nbi] = $nread; $buf[$nbi++] = $buf; |
|
519 |
} |
|
520 |
||
521 |
#--------------------------------------------- |
|
522 |
# JUST BEEN MADE ACTIVE => FLUSH BUFFERED DATA |
|
523 |
#--------------------------------------------- |
|
524 |
||
525 |
elsif ($rcv_state[$id] == $FLUSH) { |
|
526 |
if ($nbi) { |
|
527 |
print("\n"); print($COLOR[$id]) unless ($opt_s); |
|
528 |
for (my($bi)=0; $bi<$nbi; $bi++) { |
|
529 |
my($buf) = $buf[$bi]; |
|
530 |
my($nread) = $nread[$bi]; |
|
531 |
POSIX::write(1,$buf,$nread); |
|
532 |
} |
|
533 |
$nbi = 0; |
|
534 |
} |
|
535 |
$rcv_state[$id] = $ECHO; # acknowledge action |
|
536 |
} |
|
537 |
||
538 |
#-------------------------------------------------------- |
|
539 |
# UPLOADING COMMAND FILE => ECHO DATA, WAITING FOR PROMPT |
|
540 |
#-------------------------------------------------------- |
|
541 |
||
542 |
elsif ($rcv_state[$id] == $UPLOAD) { |
|
543 |
my($buf,$nread); # buffer data |
|
544 |
$nread = POSIX::read($sfd[$id],$buf,64); |
|
545 |
$nread[$nbi] = $nread; $buf[$nbi++] = $buf; |
|
546 |
if ($buf =~ /$RDI_prompt/) { # prompt => flush |
|
547 |
print("\n"); print($COLOR[$id]) unless ($opt_s); |
|
548 |
for (my($bi)=0; $bi<$nbi; $bi++) { |
|
549 |
POSIX::write(1,$buf[$bi],$nread[$bi]); |
|
550 |
} |
|
551 |
$nbi = 0; |
|
552 |
$rcv_state[$id] = $ECHO; # done |
|
553 |
} |
|
554 |
} |
|
555 |
||
556 |
#-------------------------------------- |
|
557 |
# (FINALLY) DEFAULT ACTION => ECHO DATA |
|
558 |
#-------------------------------------- |
|
559 |
||
560 |
else { # $rcv_state[$id] == $ECHO |
|
561 |
my($buf,$nread); |
|
562 |
$nread = POSIX::read($sfd[$id],$buf,64); |
|
563 |
for (my($i)=0; $i<$nread; $i++) { # clean garbage |
|
564 |
my($ascii) = ord(substr($buf,$i)); |
|
565 |
substr($buf,$i,1) = '?' |
|
566 |
unless ($ascii == 10 || $ascii == 13 || $ascii == 9 || |
|
567 |
($ascii >= 32 && $ascii <= 126)); |
|
568 |
} |
|
569 |
print($COLOR[$id]) unless ($opt_s); |
|
570 |
POSIX::write(1,$buf,$nread); |
|
571 |
} |
|
572 |
} |
|
573 |
} |
|
574 |
||
575 |
$TTY_receiver[0] = threads->new(\&TTY_receiver,0); # start threads |
|
576 |
$TTY_receiver[1] = threads->new(\&TTY_receiver,1) |
|
577 |
if defined($TTY1); |
|
578 |
||
579 |
#---------------------------------------------------------------------- |
|
580 |
# Controller (reads stdin & writes to serial ports) |
|
581 |
#---------------------------------------------------------------------- |
|
582 |
||
583 |
my($t) = POSIX::Termios::new(); # set raw mode |
|
584 |
die("${RESET}tcgetattr: $!\n") unless defined($t->getattr(0)); |
|
585 |
@ccc = ($t->getcc(POSIX::VMIN()),$t->getcc(POSIX::VTIME())); @rcc = (1,0); |
|
586 |
$clf = $t->getlflag(); $cif = $t->getiflag(); $cof = $t->getoflag(); |
|
587 |
$rlf = $clf & # linux termios manpage |
|
588 |
~(POSIX::ECHO()|POSIX::ECHONL()|POSIX::ICANON()| |
|
589 |
POSIX::IEXTEN()|POSIX::ISIG()); |
|
590 |
$rif = $cif & |
|
591 |
~(POSIX::IGNBRK()|POSIX::BRKINT()|POSIX::PARMRK()| |
|
592 |
POSIX::ISTRIP()|POSIX::INLCR()|POSIX::IGNCR()| |
|
593 |
POSIX::ICRNL()|POSIX::IXON()); |
|
594 |
$rof = $cof & ~POSIX::OPOST(); # unused |
|
595 |
||
596 |
sub croak(@) # cook and die |
|
597 |
{ |
|
598 |
$t->setlflag($clf); $t->setiflag($cif); $t->setoflag($cof); |
|
599 |
$t->setcc(POSIX::VMIN(),$ccc[0]); $t->setcc(POSIX::VTIME(),$ccc[1]); |
|
600 |
$t->setattr(0,POSIX::TCSANOW()); |
|
601 |
die(@_); |
|
602 |
} |
|
603 |
||
604 |
sub set_speed($$$) # set baud rate |
|
605 |
{ |
|
606 |
my($t,$id,$speed) = @_; |
|
607 |
$t->setispeed($TERMIOS_SPEED{$speed}); |
|
608 |
$t->setospeed($TERMIOS_SPEED{$speed}); |
|
609 |
print(STDERR "tcsetattr: $!\n"),return |
|
610 |
unless defined($t->setattr($sfd[$id],POSIX::TCSANOW)); |
|
611 |
$COMMS_SPEED[$id] = $speed; |
|
612 |
} |
|
613 |
||
614 |
sub cookedmode() # cook with errors |
|
615 |
{ |
|
616 |
$t->setlflag($clf); $t->setiflag($cif); $t->setoflag($cof); |
|
617 |
$t->setcc(POSIX::VMIN(),$ccc[0]); $t->setcc(POSIX::VTIME(),$ccc[1]); |
|
618 |
die("${RESET}tcsetattr: $!\n") |
|
619 |
unless defined($t->setattr(0,POSIX::TCSANOW())); |
|
620 |
} |
|
621 |
||
622 |
sub rawmode() # set raw mode |
|
623 |
{ |
|
624 |
$t->setlflag($rlf); $t->setiflag($rif); #$t->setoflag($rof); |
|
625 |
$t->setcc(POSIX::VMIN(),$rcc[0]); $t->setcc(POSIX::VTIME(),$rcc[1]); |
|
626 |
croak("${RESET}tcsetattr: $!\n") |
|
627 |
unless defined($t->setattr(0,POSIX::TCSANOW())); |
|
628 |
} |
|
629 |
||
630 |
sub wait_for_bit_set($$) # wait for state |
|
631 |
{ |
|
632 |
my($id,$trgbit) = @_; |
|
633 |
for (my($time) = 0; ($rcv_state[$id]&$trgbit)==0; $time+=$naptime) { |
|
634 |
croak("$COLOR[$id]Error: timeout waiting for instrument $id" . |
|
635 |
"$RESET set status bit $trgbit (status is $rcv_state[$id])\n") |
|
636 |
if ($time >= $timeout); |
|
637 |
select(undef,undef,undef,$naptime); |
|
638 |
} |
|
639 |
} |
|
640 |
||
641 |
sub wait_for_bit_cleared($$) # wait for state |
|
642 |
{ |
|
643 |
my($id,$trgbit) = @_; |
|
644 |
for (my($time) = 0; ($rcv_state[$id]&$trgbit)==$trgbit; $time+=$naptime) { |
|
645 |
croak("$COLOR[$id]Error: timeout waiting for instrument $id" . |
|
646 |
"$RESET clear status bit $trgbit (status is $rcv_state[$id])\n") |
|
647 |
if ($time >= $timeout); |
|
648 |
select(undef,undef,undef,$naptime); |
|
649 |
} |
|
650 |
} |
|
651 |
||
652 |
sub send_BREAK($) # send simple BREAK |
|
653 |
{ |
|
654 |
my($id) = @_; |
|
655 |
print(STDERR "$COLOR[$id]\{BREAK INSTRUMENT $id}") unless ($opt_s); |
|
656 |
croak("$COLOR[$id]tcsendbreak: $!$RESET\n") |
|
657 |
unless defined(POSIX::tcsendbreak($sfd[$id],0)); |
|
658 |
$rcv_state[$id] |= $SET_DEFAULT_SPEED; # ECHO or UPLOAD |
|
659 |
} |
|
660 |
||
661 |
sub help() # print help message |
|
662 |
{ |
|
663 |
my($toggle) = "^T: toggle instrument; " if defined($TTY1); |
|
664 |
print($COLOR[$cid]); |
|
665 |
print(STDERR "\n$COLOR[$cid]Instrument $cid ($COMMS_SPEED[$cid]bps)\n$COLOR[$cid]^H: help; " . |
|
666 |
"$toggle^C: BREAK; ^U: upload; ^X: download; ^S: shell; " . |
|
667 |
"^B: change baud rate; ^D: end\n"); |
|
668 |
} |
|
669 |
||
670 |
sub next_cmd($) # get next cmd from file |
|
671 |
{ |
|
672 |
my($f) = @_; |
|
673 |
||
674 |
while (defined($_ = <$f>)) { |
|
675 |
chomp; |
|
676 |
s/\s*;.*//; # remove comments |
|
677 |
next if /^\s*$/; # empty lines |
|
678 |
return $_; |
|
679 |
} |
|
680 |
return undef; |
|
681 |
} |
|
682 |
||
683 |
$cid = 0; # current instrument |
|
684 |
rawmode(); # setup |
|
685 |
help(); |
|
686 |
||
687 |
KEYSTROKE: while (POSIX::read(0,$buf,1)) { # main tty-writer loop |
|
688 |
$char = unpack('C',$buf); |
|
689 |
||
690 |
#------------------------- |
|
691 |
# HANDLE ^B (CHANGE SPEED) |
|
692 |
#------------------------- |
|
693 |
||
694 |
if ($char == 2) { |
|
695 |
if ($rcv_state[$cid] == $ECHO) { |
|
696 |
$DEFAULT_SPEED[$cid] *= 2; |
|
697 |
$DEFAULT_SPEED[$cid] = 57600 if ($DEFAULT_SPEED[$cid] == 76800); |
|
698 |
$DEFAULT_SPEED[$cid] = 300 if ($DEFAULT_SPEED[$cid] == 230400); |
|
699 |
$DEFAULT_SPEED[$cid] = 1200 if ($DEFAULT_SPEED[$cid] == 600); |
|
700 |
POSIX::write($sfd[$cid],"\r$RDI_SPEED{$DEFAULT_SPEED[$cid]}11\r",7); |
|
701 |
sleep(1); |
|
702 |
$rcv_state[$cid] |= $SET_DEFAULT_SPEED; |
|
703 |
wait_for_bit_cleared($cid,$SET_DEFAULT_SPEED); |
|
704 |
} else { |
|
705 |
print(STDERR "$COLOR[$cid]\{Can only change speed while in ECHO mode}") unless ($opt_s); |
|
706 |
} |
|
707 |
help(); |
|
708 |
} |
|
709 |
||
710 |
#----------------------- |
|
711 |
# HANDLE ^C (SEND BREAK) |
|
712 |
#----------------------- |
|
713 |
||
714 |
elsif ($char == 3) { |
|
715 |
my($cidkilled) = 0; |
|
716 |
if (($rcv_state[0]&$DOWNLOAD) || # currently downloading |
|
717 |
($rcv_state[1]&$DOWNLOAD)) { |
|
718 |
if ($rcv_state[$cid]&$DOWNLOAD) { # active-instrument downloading |
|
719 |
print(STDERR "$COLOR[$cid]\{KILLING PID $dld_pid[$cid]}") unless ($opt_s); |
|
720 |
send_BREAK($cid); kill('TERM',$dld_pid[$cid]); |
|
721 |
wait_for_bit_cleared($cid,$SET_DEFAULT_SPEED); |
|
722 |
send_BREAK($cid); kill('TERM',$dld_pid[$cid]); |
|
723 |
$cidkilled = 1; |
|
724 |
} |
|
725 |
if ($rcv_state[!$cid]&$DOWNLOAD) { # inactive-instrument dld'ing |
|
726 |
if ($cidkilled) { # active killed as well |
|
727 |
$tmp = $rcv_state[$cid]&~$ECHO; $rcv_state[$cid] = $tmp|$BUFFER; |
|
728 |
$cid = 1*!$cid; # toggle instruments |
|
729 |
$tmp = $rcv_state[$cid]&~$BUFFER; $rcv_state[$cid] = $tmp|$FLUSH; |
|
730 |
wait_for_bit_cleared($cid,$FLUSH); # flush before killing |
|
731 |
||
732 |
print(STDERR "$COLOR[$cid]\{KILLING PID $dld_pid[$cid]}") unless ($opt_s); |
|
733 |
send_BREAK($cid); kill('TERM',$dld_pid[$cid]); |
|
734 |
wait_for_bit_cleared($cid,$SET_DEFAULT_SPEED); |
|
735 |
send_BREAK($cid); |
|
736 |
wait_for_bit_cleared($cid,$SET_DEFAULT_SPEED); |
|
737 |
||
738 |
$tmp = $rcv_state[$cid]&~$ECHO; $rcv_state[$cid] = $tmp|$BUFFER; |
|
739 |
$cid = 1*!$cid; # toggle back |
|
740 |
$tmp = $rcv_state[$cid]&~$BUFFER; $rcv_state[$cid] = $tmp|$FLUSH; |
|
741 |
wait_for_bit_cleared($cid,$FLUSH); |
|
742 |
} else { # tried to send BREAK |
|
743 |
if ($cid == 0) { # while inactive dld'ing |
|
744 |
printf(STDERR "$COLOR[0]\{REFUSE TO SEND BREAK -$COLOR[1]- " . |
|
745 |
"INSTRUMENT 1 DOWNLOAD IN PROGRESS}\n"); |
|
746 |
} else { |
|
747 |
printf(STDERR "$COLOR[1]\{REFUSE TO SEND BREAK -$COLOR[0]- " . |
|
748 |
"INSTRUMENT 1 DOWNLOAD IN PROGRESS}\n"); |
|
749 |
} |
|
750 |
} |
|
751 |
} |
|
752 |
} else { # none downloading |
|
753 |
send_BREAK($cid); # send BREAK |
|
754 |
wait_for_bit_cleared($cid,$SET_DEFAULT_SPEED); |
|
755 |
} |
|
756 |
} |
|
757 |
||
758 |
#----------------- |
|
759 |
# HANDLE ^D (EXIT) |
|
760 |
#----------------- |
|
761 |
||
762 |
elsif ($char == 4) { |
|
763 |
if (($rcv_state[0]&$DOWNLOAD)|($rcv_state[1]&$DOWNLOAD)) { |
|
764 |
print(STDERR "$COLOR[$cid]\{DOWNLOAD(S) IN PROGRESS --- ^C TO ABORT}\n"); |
|
765 |
} else { |
|
766 |
last; |
|
767 |
} |
|
768 |
} |
|
769 |
||
770 |
#----------------- |
|
771 |
# HANDLE ^H (HELP) |
|
772 |
#----------------- |
|
773 |
||
774 |
elsif ($char == 8) { help(); } |
|
775 |
||
776 |
#------------------------- |
|
777 |
# HANDLE ^S (SHELL ESCAPE) |
|
778 |
#------------------------- |
|
779 |
||
780 |
elsif ($char == 19) { |
|
781 |
$tmp = $rcv_state[$cid]&~$ECHO; $rcv_state[$cid] = $tmp|$BUFFER; |
|
782 |
print($RESET); |
|
783 |
cookedmode(); |
|
784 |
system($shell) && print(STDERR "$shell: $!"); |
|
785 |
rawmode(); help(); |
|
786 |
$tmp = $rcv_state[$cid]&~$BUFFER; $rcv_state[$cid] = $tmp|$FLUSH; |
|
787 |
wait_for_bit_cleared($cid,$FLUSH); |
|
788 |
} |
|
789 |
||
790 |
#------------------------------- |
|
791 |
# HANDLE ^T (TOGGLE INSTRUMENTS) |
|
792 |
#------------------------------- |
|
793 |
||
794 |
elsif ($char == 20 && defined($TTY1)) { |
|
795 |
$tmp = $rcv_state[$cid]&~$ECHO; $rcv_state[$cid] = $tmp|$BUFFER; |
|
796 |
$cid = 1*!$cid; print("\n"); |
|
797 |
help(); |
|
798 |
$tmp = $rcv_state[$cid]&~$BUFFER; $rcv_state[$cid] = $tmp|$FLUSH; |
|
799 |
wait_for_bit_cleared($cid,$FLUSH); |
|
800 |
} |
|
801 |
||
802 |
#---------------------------- |
|
803 |
# HANDLE ^U (UPLOAD CMD-FILE) |
|
804 |
#---------------------------- |
|
805 |
||
806 |
elsif ($char == 21) { |
|
807 |
if ($rcv_state[$cid]&$DOWNLOAD){ |
|
808 |
print(STDERR "$COLOR[$cid]\{DOWNLOAD IN PROGRESS --- ^C TO ABORT}\n"); |
|
809 |
} else { |
|
810 |
$tmp = $rcv_state[$cid]&~$ECHO; $rcv_state[$cid] = $tmp|$BUFFER; |
|
811 |
print($RESET); |
|
812 |
cookedmode(); |
|
813 |
do { |
|
814 |
print("\nCommand File: "); chomp($_ = <STDIN>); |
|
815 |
if ($_ eq '') { # no file name given |
|
816 |
print("{upload canceled}\n"); |
|
817 |
rawmode(); |
|
818 |
$tmp = $rcv_state[$cid]&~$BUFFER; $rcv_state[$cid] = $tmp|$FLUSH; |
|
819 |
wait_for_bit_cleared($cid,$FLUSH); |
|
820 |
next KEYSTROKE; |
|
821 |
} |
|
822 |
unless (open(CF,$_)) { |
|
823 |
print("$_: $!"); |
|
824 |
redo; |
|
825 |
} |
|
826 |
} while (0); |
|
827 |
rawmode(); |
|
828 |
$tmp = $rcv_state[$cid]&~$BUFFER; $rcv_state[$cid] = $tmp|$FLUSH; |
|
829 |
wait_for_bit_cleared($cid,$FLUSH); |
|
830 |
||
831 |
my($cmd) = next_cmd(CF); # read ahead (last cmd may ... |
|
832 |
my($next_cmd); # ... not generate prompt) |
|
833 |
while (defined($next_cmd = next_cmd(CF))) { |
|
834 |
$rcv_state[$cid] = $UPLOAD; |
|
835 |
if ($cmd eq '<BREAK>') { |
|
836 |
send_BREAK($cid); |
|
837 |
} else { |
|
838 |
POSIX::write($sfd[$cid],"$cmd\r",length($cmd)+1); |
|
839 |
} |
|
840 |
$cmd = $next_cmd; |
|
841 |
wait_for_bit_set($cid,$ECHO); # NOT SURE!!! |
|
842 |
} |
|
843 |
close(CF); |
|
844 |
POSIX::write($sfd[$cid],"$cmd\r",length($cmd)+1); # last cmd |
|
845 |
||
846 |
$tmp = $rcv_state[$cid]&~$ECHO; $rcv_state[$cid] = $tmp|$BUFFER; |
|
847 |
print("\n${RESET}{upload finished}\n"); |
|
848 |
$tmp = $rcv_state[$cid]&~$BUFFER; $rcv_state[$cid] = $tmp|$FLUSH; |
|
849 |
wait_for_bit_cleared($cid,$FLUSH); |
|
850 |
} |
|
851 |
} |
|
852 |
||
853 |
#-------------------------- |
|
854 |
# HANDLE ^X (DOWNLOAD DATA) |
|
855 |
#-------------------------- |
|
856 |
||
857 |
elsif ($char == 24) { |
|
858 |
if ($rcv_state[$cid]&$DOWNLOAD){ |
|
859 |
print(STDERR "$COLOR[$cid]\{DOWNLOAD IN PROGRESS --- ^C TO ABORT}\n"); |
|
860 |
} else { |
|
861 |
$rcv_state[$cid] = $SET_DOWNLOAD_SPEED; |
|
862 |
wait_for_bit_set($cid,$ECHO); |
|
863 |
$rcv_state[$cid] = $DOWNLOAD; # start waiting for instr. ready |
|
864 |
POSIX::write($sfd[$cid],"$START_DOWNLOAD_RDI_COMMAND\r", |
|
865 |
length($START_DOWNLOAD_RDI_COMMAND)+1); |
|
866 |
wait_for_bit_set($cid,$ECHO); |
|
867 |
} |
|
868 |
} |
|
869 |
||
870 |
#------------------------------------------------------------------ |
|
871 |
# (FINALLY) HANDLE DEFAULT CASE: ECHO KEYBOARD INPUT TO SERIAL PORT |
|
872 |
#------------------------------------------------------------------ |
|
873 |
||
874 |
else { POSIX::write($sfd[$cid],$buf,1); } |
|
875 |
||
876 |
} |
|
877 |
||
878 |
#------------------- |
|
879 |
# Exit Received (^D) |
|
880 |
#------------------- |
|
881 |
||
882 |
if ($rcv_state[0]&$DOWNLOAD) { # abort downloads on close |
|
883 |
send_BREAK(0); kill('TERM',$dld_pid[0]); |
|
884 |
wait_for_bit_cleared(0,$SET_DEFAULT_SPEED); |
|
885 |
send_BREAK(0); |
|
886 |
wait_for_bit_cleared(0,$SET_DEFAULT_SPEED); |
|
887 |
} |
|
888 |
if ($rcv_state[1]&$DOWNLOAD) { |
|
889 |
send_BREAK(1); kill('TERM',$dld_pid[1]); |
|
890 |
wait_for_bit_cleared(1,$SET_DEFAULT_SPEED); |
|
891 |
send_BREAK(1); |
|
892 |
wait_for_bit_cleared(1,$SET_DEFAULT_SPEED); |
|
893 |
} |
|
894 |
||
895 |
$rcv_state[0] = $rcv_state[1] = $SHUTDOWN; # tell receivers to stop |
|
896 |
$TTY_receiver[0]->join(); # wait for them |
|
897 |
$TTY_receiver[1]->join() if defined($TTY1); |
|
898 |
||
899 |
cookedmode(); # reset keyboard |
|
900 |
print("$RESET\n"); # and screen |
|
901 |
||
902 |
exit(0); |
|
903 |