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