#!/usr/bin/perl
#======================================================================
# B B A B B L E
# doc: Thu Mar 11 01:00:51 2004
# dlm: Fri Jul 3 10:12:51 2020
# (c) 2004 A.M. Thurnherr
# uE-Info: 58 0 NIL 0 0 72 10 2 8 NIL ofnI
#======================================================================
# Broad Band Babble --- talk to 1--2 RDI ADCPs or other serial instruments
# HISTORY:
# Mar 5, 2004: - written first, one-page-long proof-of-concept version
# Mar 6, 2004: - added downloading
# Mar 7, 2004: - made it portable (linux & MacOSX)
# Mar 8, 2004: - made stdin rawmode
# - colorized
# Mar 9, 2004: - added support for 2nd instrument
# - allowed for high-speed wire crosstalk (disallow BREAK
# while download is going on)
# Mar 10, 2004: - added -m)onochrome to aid expect(1)
# Mar 11, 2004: - made fully compatible with expect(1) by adding -s
# (disable asyncronous messages)
# Mar 12, 2004: - various improvements
# Mar 18, 2004: - re-added async download errmesg on failed downloads
# to allow aborting 2nd download if one fails
# Mar 21, 2004: - added proper syncronization for download (waiting for
# instrument to tell us to start the host)
# Apr 4, 2004: - added comments
# Jun 14, 2004: - added port-open delay for KESPAN 49W multiport adapter
# - BB150 requires \r after commands instead of \n
# - added support for lack of ymodem prompt of BB150
# Jan 19, 2006: - added code to determine whether ymodem receiver is
# called rb or lrb
# Jan 25, 2006: - removed default download prompt
# - re-directed stderr of `which lrb` because of linux
# Aug 7, 2006: - added ^U(pload) capability on L'Atalante (DYNAMUCK)
# - BUG: length of $DOWNLOAD_SPEED_RDI_COMMAND was hardcoded
# - BUG: $START_DOWNLOAD_RDI_COMMAND was hardcoded
# - BUG: FreeBSD needs a nap between writing baudrate-
# change command & setattr()
# Aug 8, 2006: - added support for $PROGRAMMING_SPEED_TERMIOS_CONST
# Aug 28, 2006: - updated doc
# Nov 14, 2006: - added ^B (baud-rate handling)
# - changes to task syncronization
# - replace unprintable chars by ? while in ECHO mode (only!)
# Aug 26, 2010: - added -y)modem receive
# Oct 18, 2010: - added -u option to default ymodem receive call
# Dec 1, 2010: - BUG: -y with empty-string option argument did not work
# Jun 18, 2018: - explicitly implemented code to disable download on -y ""
# - BUG: one debug message had -s wrong way round
# - added state-change test required when Arduino closes USB connection
# - BUG: non-existing ttys had stupid error messages
# - made -s default and added -a to show async output, which is for debugging only
# - changed default to use -m unless 2 devices are chosen
# - begin implementing non-R)DI mode (currently, upload only)
# Jul 3, 2020: - expunged master/slave terminology
#----------------------------------------------------------------------
# USAGE
#----------------------------------------------------------------------
use Getopt::Std;
$USAGE = "Usage: $0 [-m)onochrome] [-s)uppress async output(default)] [produce -a)sync ouput]" .
"[-y)modem receive <cmd[\"\" for none]>] [non-R)DI mode]" .
"<tty0_device> [tty1_device]\n";
die($USAGE) unless (getopts("amRsy:"));
$opt_s = 1 unless ($opt_a);
$opt_m = 1 unless (@ARGV > 1);
#============================== USER MANUAL ==============================
# bbabble is started with 1 or 2 arguments, which are tty special files.
# On LINUX, /dev/ttyS0 is com1: /dev/ttyS1 is com2: /dev/ttyUSB0 is the
# first USB tty port, /dev/ttyUSB1 is the 2nd, &c. If two ttys are
# specified bbabble can talk to two instruments in parallel. Communication
# with The first (second) port is shown in red (blue). For consistency
# with the color scheme used by the LDEO expect scripts, the instrument
# sending the sync pulses (downlooker) should be connected to the first
# tty given on the command line. When only one port is specified, the
# -m)onochrome option is assumed.
# Upon startup, bbabble prints a help message showing the current
# "foreground" instrument as well as a list of legal keyboard commands.
# These should be largely self explanatory. Initially, bbabble
# is set up to talk to the instrument connected to the first tty. When
# 2 ttys are given on the command line, ^T (ctrl-T) can be used to toggle
# between the instruments --- ^T is not available if only one tty is
# given on the command line.
# When bbabble talks to two instrument, the output from the "background"
# instrument is buffered internally. When ^T is pressed all buffered output
# is flushed to the screen.
# ^C sends a BREAK to the currently active instrument, but only if neither
# of the instruments is currently downloading. If the "foreground" instrument
# is downloading, ^C aborts the download. If the "background" instrument is
# downloading an error message is produced but no BREAK is sent. (This
# behaviour is necessariy because it was found that a BREAK sent to the
# "foreground" instrument somtimes aborts a high-speed download in progress
# from the "background" instrument. Perhaps this is only the case with
# LDEO cabling with shared ground.
# ^X starts a high-speed download from the "foreground" instrument.
# Once the download has been started, the "background" instrument can be
# brought into the foreground with ^T in order to start a parallel download
# or the user can escape to the shell using ^S. In any case, asyncronous
# messages are printed (in the corresponding color) whenever one of the two
# instruments has finished the download (except when -s is used to suppress
# asynchronous messages).
# On ^U the user is asked for a command-file-name to be uploaded to the
# instrument. The command file may contain any valid RDI command, empty
# lines, as well as comments beginning with a semicolon (;).
#====================== USAGE NOTES ==============================
# On some (especially BSD-based) systems there are separate tty
# device files for dialin and dialout operations. Only the latter work
# with bbabble. They traditionally have names matching /dev/cu* (e.g.
# /dev/cuad0 for the first serial # port in FreeBSD).
# In order to have read/write access to the device files, the user
# that is to run bbabble should be added to the group that owns
# the tty device files (e.g. dialer on FreeBSD).
# Upon startup, bbabble expects to communicate with the ADCPs at 9600bps
# (baud). If the user sends a BREAK (^C) and garbage is produced the
# instrument's default baud rate is probably set to a different value.
# ^B cycles through all available instrument baud rates by first sending
# the corresponding command (e.g. CB411) to the instrument and then
# changing the TTY line characteristics. With this scheme it should be
# possible to reset the default baudrate of the instrument by executing
# the following steps:
# 1. start bbabble
# 2. type ^C to wake the instrument
# 3. type ^B nine times (wait a couple of seconds between keystrokes)
# 4. issue the command "CK" to save the current baudrate as default
# 5. issue the command "CZ" to send the instrument to sleep
# 6. type ^D to exit bbabble
#----------------------------------------------------------------------
# IMPLEMENTATION NOTES
#----------------------------------------------------------------------
# DOWNLOAD BAUD RATE
# Most of the communication is carried out at the default baud rate
# (initially set to 9600baud, but can be changed with ^B). For
# downloading the communications speed is increased to 115kbps. The
# baud rate is dropped to the default on the next BREAK. Unfortunately,
# the POSIX standard only deals with baud rates up to 38400 bps. Therefore,
# I had to implement a failry dreadful hack using a call to the c
# preprocessor to determine the correct argument to set higher
# baud rates. This works only if gcc is installed...
#
# NOTE: After a download has completed the instrument stays in
# high-speed mode. When the current parameters are stored in
# non-volatile memory (CK command) at this stage the instrument's
# default speed is 115kbps and has to be reset explicitly.
# OTHER COMMUNICATIONS PARAMETERS
# bbabble assumes the ADCPs to use no parity, 8 data bits and 1 stop bit.
# Other parameters require changes to bbabble.
# THREADS
# Writing a dumb terminal with threads is dead easy: one thread reads
# from the keyboard and writes to the serial device and another reads
# from the serial devices and writes to the screen. A first version
# of bbabble was less than 50 lines of perl code. The current version
# is much longer because the threads must synchronize. This is accomplished
# by the tty-reader threads (one per active tty) being implemented as
# finite-state automata. The tty-writer (or keyboard-reader) thread
# sends commands to the tty-readers by changing the corresponding global
# state # variable and waiting for a response-change in the same
# variable.
# NB: bbabble NEEDS A THREADED VERSION OF PERL. DEFAULT VERSIONS, E.G.
# ON MACOSX ARE NOT THREADED!
#----------------------------------------------------------------------
# TWEAKABLES
#----------------------------------------------------------------------
# The following defines the command sent to the ADCP to start
# downloading. (NB: RY0 is more portable than RY, which does not work
# for BB150 instruments)
$START_DOWNLOAD_RDI_COMMAND = 'RY0';
# After a download is initiated with the RY0 command, WorkHorses
# send a prompt, telling the user to start downloading, while BB150 do not.
# Set the following variables to the prompt returned by the instrument.
# An empty string means that no prompt is expected, but a gratuitous
# pause of 1s is inserted instead, just in case. This is now made the default,
# because is it more portable.
#$ymodem_download_prompt[0] = 'Please start your host now';
#$ymodem_download_prompt[1] = 'Please start your host now';
$ymodem_download_prompt[0] = '';
$ymodem_download_prompt[1] = '';
# Downloading should be done at the highest possible speed. 115200 bps has
# always worked well for me, with a variety of ADCP heads and acquisition
# computers.
#$DOWNLOAD_SPEED = 9600;
#$DOWNLOAD_SPEED = 38400;
#$DOWNLOAD_SPEED = 57600;
$DOWNLOAD_SPEED = 115200;
# I prefer communicating at 9600 bps, except when downloading.
# Other users prefer faster speeds, and the following variable allows
# selecting the default speed. Note that it must be consistent with the
# speed saved in the user settings of the ADCP (last CK command).
my(@DEFAULT_SPEED):shared;
my(@COMMS_SPEED):shared;
$DEFAULT_SPEED[0] = 9600;
$DEFAULT_SPEED[1] = 9600;
# bbabble allows an escape to the shell, for example during downloading.
# You can chose which shell it uses. If you chose anything but /bin/ksh
# you obviously don't know what you're doing. Linux does not come with
# /bin/ksh by default. They obviously don't know what they're doing.
$shell = '/bin/sh';
# Synchronization between the threads is accomplished using spin locks.
# The $naptime variable determines how fast the locks spin and determine
# the maximum response time in seconds.
$naptime = 0.1; # nap time in seconds
# If after $timeout seconds thread syncronization has not been achieved,
# a timeout error is generated.
$timeout = 10; # timeout waiting for instrument
# The following are the tput(1) colors. They should be set to the standard
# text color (black), red and blue, respectively. To test them, simply type
# `tput setaf 1', and you should get red text on whatever background
# was previously selected.
$COLOR_RESET = 0;
$COLOR_TTY0 = 1;
$COLOR_TTY1 = 4;
# RDI instruments use the ymodem protocol to transfer files. There is
# a public-domain version of ymodem that works very well. Depending on
# the UNIX version, the ymodem-receiver can be called `rb' or `lrb'.
# It does not have its own manpage but is described in the man page of
# `rz' (the zmodem receiver). To make matters worse, In the man page
# the prgram is always called `rb', even on systems where the executable
# is `lrb'.
# If -y is not given, bbabble trys to find one of the standard ymodem
# executables. Using -y allows options to be set.
if (defined($opt_y)) {
if (length($opt_y) > 0) {
$receive_ymodem = $opt_y;
}
} else {
chomp($receive_ymodem = `which lrb 2>/dev/null`);
chomp($receive_ymodem = `which rb 2>/dev/null`)
if ($receive_ymodem eq '');
die("$0: cannot find rb or lrb\n")
if ($receive_ymodem eq '');
$receive_ymodem .= ' -u'; # keep upper-case filenames
}
# When uploading command files, each command is sent after a prompt
# is received from the instrument. The following variable defines the
# prompt (as a perl regexpr). ANCHOR AT END ONLY!!!
$RDI_prompt = '>$';
#======================================================================
# PROGRAM
#======================================================================
use threads;
use threads::shared;
use IO::Handle;
use POSIX ();
if (scalar(@ARGV) == 1) {
$TTY0 = $ARGV[0];
} elsif (scalar(@ARGV) == 2) {
$TTY0 = $ARGV[0];
$TTY1 = $ARGV[1];
} else {
die($USAGE);
}
#----------------------------------------------------------------------
# determine baudrate tcsetospeed() arguments
#----------------------------------------------------------------------
$TERMIOS_SPEED{300} = &POSIX::B300; $RDI_SPEED{300} = 'CB0';
$TERMIOS_SPEED{1200} = &POSIX::B1200; $RDI_SPEED{1200} = 'CB1';
$TERMIOS_SPEED{2400} = &POSIX::B2400; $RDI_SPEED{2400} = 'CB2';
$TERMIOS_SPEED{4800} = &POSIX::B4800; $RDI_SPEED{4800} = 'CB3';
$TERMIOS_SPEED{9600} = &POSIX::B9600; $RDI_SPEED{9600} = 'CB4';
$TERMIOS_SPEED{19200} = &POSIX::B19200; $RDI_SPEED{19200} = 'CB5';
$TERMIOS_SPEED{38400} = &POSIX::B38400; $RDI_SPEED{38400} = 'CB6';
$RDI_SPEED{57600} = 'CB7';
$RDI_SPEED{57600} = 'CB7';
$RDI_SPEED{115200} = 'CB8';
# The following is ugly & slow, but seems fairly portable.
open(TMP,'>/tmp/tt.c'); print(TMP "#include <termios.h>\nB57600\n");
close(TMP);
$TERMIOS_SPEED{57600} = `gcc -E /tmp/tt.c | tail -1`;
$TERMIOS_SPEED{57600} = hex($TERMIOS_SPEED{57600})
if ($TERMIOS_SPEED{57600} =~ /^0x/);
$TERMIOS_SPEED{57600} = oct($TERMIOS_SPEED{57600})
if ($TERMIOS_SPEED{57600} =~ /^0/);
open(TMP,'>/tmp/tt.c'); print(TMP "#include <termios.h>\nB115200\n");
close(TMP);
$TERMIOS_SPEED{115200} = `gcc -E /tmp/tt.c | tail -1`;
$TERMIOS_SPEED{115200} = hex($TERMIOS_SPEED{115200})
if ($TERMIOS_SPEED{115200} =~ /^0x/);
$TERMIOS_SPEED{115200} = oct($TERMIOS_SPEED{115200})
if ($TERMIOS_SPEED{115200} =~ /^0/);
unlink('/tmp/tt.c');
#----------------------------------------------------------------------
# Common Setup
#----------------------------------------------------------------------
$COMMS_SPEED[0] = $DEFAULT_SPEED[0]; # baud rates
$COMMS_SPEED[1] = $DEFAULT_SPEED[1];
unless ($opt_m) { # colors
$RESET = `tput setaf $COLOR_RESET`;
@COLOR = (`tput setaf $COLOR_TTY0` ,
`tput setaf $COLOR_TTY1`);
}
my(@sfd); # TTYs
-c $TTY0 || die("$TTY0: no such file or directory\n");
open(TTY0,'+>',$TTY0) || die("$TTY0: $!\n");
$sfd[0] = fileno(TTY0);
if (defined($TTY1)) {
select(undef,undef,undef,$naptime); # KEYSPAN 49W requires this
-c $TTY1 || die("$TTY1: no such file or directory\n");
open(TTY1,'+>',$TTY1) || die("$TTY1: $!\n");
$sfd[1] = fileno(TTY1);
}
STDOUT->autoflush(1); # flushing
STDERR->autoflush(1);
#----------------------------------------------------------------------
# TTY-Reader Threads
#----------------------------------------------------------------------
# valid states of the receiver FSA; NB: DOWNLOAD can be combined with
# BUFFER and ECHO; SET_DEFAULT_SPEED (used during BREAK) can be combined
# with UPLOAD & ECHO (w or w/o DOWNLOAD).
my($SHUTDOWN):shared = 0x00; # terminate
my($ECHO):shared = 0x01; # normal state of active instrument
my($BUFFER):shared = 0x02; # normal state of inactive instrument
my($FLUSH):shared = 0x04; # flush buffered data
my($SET_DOWNLOAD_SPEED):shared= 0x10; # change baudrate
my($SET_DEFAULT_SPEED):shared = 0x20; # change baudrate
my($UPLOAD):shared = 0x40; # upload cmd file
my($DOWNLOAD):shared = 0x80; # download (using ymodem)
my(@rcv_state):shared = ($ECHO,$BUFFER); # initial states
my(@dld_pid):shared; # downloader pids
sub TTY_receiver($)
{
my($id) = @_;
my($t) = POSIX::Termios::new(); # setup serial line
print(STDERR "$COLOR[$id]tcgetattr: $!\n"),return # ... N81
unless defined($t->getattr($sfd[$id]));
$t->setiflag($t->getiflag() & ~(POSIX::IGNBRK() |
POSIX::BRKINT() |
POSIX::PARMRK() |
POSIX::ISTRIP() |
POSIX::INLCR() |
POSIX::IGNCR() |
POSIX::ICRNL() |
POSIX::IXON()));
$t->setoflag($t->getoflag() & ~POSIX::OPOST());
$t->setlflag($t->getlflag() & ~(POSIX::ECHO() |
POSIX::ECHONL() |
POSIX::ICANON() |
POSIX::ISIG() |
POSIX::IEXTEN()));
$t->setcflag($t->getcflag() & ~(POSIX::CSIZE()|POSIX::PARENB())
| POSIX::CS8());
$t->setcc(POSIX::VMIN,1); $t->setcc(POSIX::VTIME,0);
set_speed($t,$id,$DEFAULT_SPEED[$id]);
unless ($opt_s) {
print($COLOR[$id]) unless ($opt_m);
print("{TTY $id READY}");
}
my(@buf,$rin);
my($nbi) = 0; # next buffer
while (1) { # reader loop
vec($rin,$sfd[$id],1) = 1;
while (!select($rin,undef,undef,$naptime)) { # wait for data
return unless ($rcv_state[$id]); # ... or state change
last unless ($rcv_state[$id] == $ECHO ||
$rcv_state[$id] == $BUFFER);
vec($rin,$sfd[$id],1) = 1;
}
last unless ($rcv_state[$id] == $ECHO || # needed when Arduino USB interface is closed at other end
$rcv_state[$id] == $BUFFER);
#------------------------------
# DOWNLOAD DATA FROM INSTRUMENT
#------------------------------
if ($rcv_state[$id] == $DOWNLOAD) { # initiate download
if ($ymodem_download_prompt[$id] eq '') { # no prompt from instrument
sleep(1);
} else {
my($buf,$msg,$nread); # wait for RDI prompt
print(STDERR "$COLOR[$id]\{WAITING FOR RDI DOWNLOAD PROMPT}\n")
unless ($opt_s);
do {
$nread = POSIX::read($sfd[$id],$buf,64);
die("$COLOR[$id]read: EOF\n") if ($nread == 0);
die("$COLOR[$id]read: $!\n") if ($nread < 0);
POSIX::write(1,$buf,$nread);
$msg = unpack("a$nread",$buf);
} until ($msg =~ /$ymodem_download_prompt[$id]/);
}
print(STDERR "$COLOR[$id]\{STARTING DOWNLOAD}\n") # start ymodem receiver
unless ($opt_s);
my($rfd,$wfd) = POSIX::pipe();
$dld_pid[$id] = fork();
if ($dld_pid[$id] == 0) {
POSIX::dup2($sfd[$id],0);
POSIX::dup2($sfd[$id],1);
POSIX::dup2($wfd,2);
POSIX::close($rfd); POSIX::close($wfd);
exec($receive_ymodem);
die("$COLOR[$id]exec: $!$RESET\n");
}
POSIX::close($wfd); # handle progress data
while (1) {
my($buf,$nread);
$nread = POSIX::read($rfd,$buf,64);
$rcv_state[$id] |= $ECHO # initially, echo tty
if ($rcv_state[$id] == $DOWNLOAD);
last if ($nread == 0); # EOF => ymodem done
if ($rcv_state[$id]&$BUFFER) { # buffer data
$nread[$nbi] = $nread;
$buf[$nbi++] = $buf;
} elsif ($rcv_state[$id]&$FLUSH) { # flush buffered data
print($COLOR[$id]) unless ($opt_s);
for (my($bi)=0; $bi<$nbi; $bi++) {
my($buf) = $buf[$bi];
my($nread) = $nread[$bi];
POSIX::write(1,$buf,$nread);
}
$nbi = 0;
$rcv_state[$id] = $DOWNLOAD|$ECHO; # now, continue echoing
POSIX::write(1,$buf,$nread); # don't forget!
} else { # echo data
print($COLOR[$id]) unless ($opt_s);
POSIX::write(1,$buf,$nread);
}
}
POSIX::close($rfd);
my($rip) = waitpid($dld_pid[$id],0); # ymodem has finished
print(STDERR "$COLOR[$id]waitpid($dld_pid[$id]->$rip: $!\n"),return
unless ($rip == $dld_pid[$id]);
if (POSIX::WIFEXITED($?)) { # check exit status
if (POSIX::WEXITSTATUS($?)) { # error
print(STDERR $COLOR[$id]) unless ($opt_m);
printf(STDERR "{DOWNLOAD EXITED ABNORMALLY --- STATUS %d}$RESET",
POSIX::WEXITSTATUS($?));
} else { # no error
print(STDERR "$COLOR[$id]\{DOWNLOAD INSTRUMENT $id OK}\n$RESET")
unless ($opt_s);
}
} elsif (POSIX::WIFSIGNALED($?)) { # killed by signal
print(STDERR $COLOR[$id]) unless ($opt_m);
printf(STDERR "{DOWNLOAD KILLED BY SIGNAL %d}$RESET",
POSIX::WTERMSIG($?));
} else { # should not happen!
print(STDERR $COLOR[$id]) unless ($opt_m);
printf(STDERR "{UNKNOWN DOWNLOAD TERMINATION --- STATUS %d}$RESET",$?);
}
$rcv_state[$id] &= ~$DOWNLOAD; # acknowledge operation
}
#------------------------------
# SET DOWNLOAD BAUD RATE
#------------------------------
elsif ($rcv_state[$id] == $SET_DOWNLOAD_SPEED) {
print(STDERR "$COLOR[$id]\{SETTING DOWNLOAD SPEED}") unless ($opt_s);
POSIX::write($sfd[$id],"$RDI_SPEED{$DOWNLOAD_SPEED}11\r",6);
select(undef,undef,undef,$naptime);
set_speed($t,$id,$DOWNLOAD_SPEED);
$rcv_state[$id] = $ECHO; # acknowledge operation
}
#------------------------------
# SET NORMAL BAUD RATE
#------------------------------
elsif ($rcv_state[$id]&$SET_DEFAULT_SPEED) {
print(STDERR "$COLOR[$id]\{SETTING DEFAULT SPEED}") unless ($opt_s);
set_speed($t,$id,$DEFAULT_SPEED[$id]);
$rcv_state[$id] &= ~$SET_DEFAULT_SPEED; # acknowledge operation
}
#-----------------------------------
# INACTIVE INSTRUMENT => BUFFER DATA
#-----------------------------------
elsif ($rcv_state[$id] == $BUFFER) {
my($buf,$nread);
$nread = POSIX::read($sfd[$id],$buf,64);
$nread[$nbi] = $nread; $buf[$nbi++] = $buf;
}
#---------------------------------------------
# JUST BEEN MADE ACTIVE => FLUSH BUFFERED DATA
#---------------------------------------------
elsif ($rcv_state[$id] == $FLUSH) {
if ($nbi) {
print("\n"); print($COLOR[$id]) unless ($opt_s);
for (my($bi)=0; $bi<$nbi; $bi++) {
my($buf) = $buf[$bi];
my($nread) = $nread[$bi];
POSIX::write(1,$buf,$nread);
}
$nbi = 0;
}
$rcv_state[$id] = $ECHO; # acknowledge action
}
#--------------------------------------------------------
# UPLOADING COMMAND FILE => ECHO DATA, WAITING FOR PROMPT
#--------------------------------------------------------
elsif ($rcv_state[$id] == $UPLOAD) {
my($buf,$nread); # buffer data
$nread = POSIX::read($sfd[$id],$buf,64);
$nread[$nbi] = $nread; $buf[$nbi++] = $buf;
if ($buf =~ /$RDI_prompt/) { # prompt => flush
print("\n"); print($COLOR[$id]) unless ($opt_s);
for (my($bi)=0; $bi<$nbi; $bi++) {
POSIX::write(1,$buf[$bi],$nread[$bi]);
}
$nbi = 0;
$rcv_state[$id] = $ECHO; # done
}
}
#--------------------------------------
# (FINALLY) DEFAULT ACTION => ECHO DATA
#--------------------------------------
else { # $rcv_state[$id] == $ECHO
my($buf,$nread);
$nread = POSIX::read($sfd[$id],$buf,64);
for (my($i)=0; $i<$nread; $i++) { # clean garbage
my($ascii) = ord(substr($buf,$i));
substr($buf,$i,1) = '?'
unless ($ascii == 10 || $ascii == 13 || $ascii == 9 ||
($ascii >= 32 && $ascii <= 126));
}
print($COLOR[$id]) unless ($opt_s);
POSIX::write(1,$buf,$nread);
}
}
}
$TTY_receiver[0] = threads->new(\&TTY_receiver,0); # start threads
$TTY_receiver[1] = threads->new(\&TTY_receiver,1)
if defined($TTY1);
#----------------------------------------------------------------------
# Controller (reads stdin & writes to serial ports)
#----------------------------------------------------------------------
my($t) = POSIX::Termios::new(); # set raw mode
die("${RESET}tcgetattr: $!\n") unless defined($t->getattr(0));
@ccc = ($t->getcc(POSIX::VMIN()),$t->getcc(POSIX::VTIME())); @rcc = (1,0);
$clf = $t->getlflag(); $cif = $t->getiflag(); $cof = $t->getoflag();
$rlf = $clf & # linux termios manpage
~(POSIX::ECHO()|POSIX::ECHONL()|POSIX::ICANON()|
POSIX::IEXTEN()|POSIX::ISIG());
$rif = $cif &
~(POSIX::IGNBRK()|POSIX::BRKINT()|POSIX::PARMRK()|
POSIX::ISTRIP()|POSIX::INLCR()|POSIX::IGNCR()|
POSIX::ICRNL()|POSIX::IXON());
$rof = $cof & ~POSIX::OPOST(); # unused
sub croak(@) # cook and die
{
$t->setlflag($clf); $t->setiflag($cif); $t->setoflag($cof);
$t->setcc(POSIX::VMIN(),$ccc[0]); $t->setcc(POSIX::VTIME(),$ccc[1]);
$t->setattr(0,POSIX::TCSANOW());
die(@_);
}
sub set_speed($$$) # set baud rate
{
my($t,$id,$speed) = @_;
$t->setispeed($TERMIOS_SPEED{$speed});
$t->setospeed($TERMIOS_SPEED{$speed});
print(STDERR "tcsetattr: $!\n"),return
unless defined($t->setattr($sfd[$id],POSIX::TCSANOW));
$COMMS_SPEED[$id] = $speed;
}
sub cookedmode() # cook with errors
{
$t->setlflag($clf); $t->setiflag($cif); $t->setoflag($cof);
$t->setcc(POSIX::VMIN(),$ccc[0]); $t->setcc(POSIX::VTIME(),$ccc[1]);
die("${RESET}tcsetattr: $!\n")
unless defined($t->setattr(0,POSIX::TCSANOW()));
}
sub rawmode() # set raw mode
{
$t->setlflag($rlf); $t->setiflag($rif); #$t->setoflag($rof);
$t->setcc(POSIX::VMIN(),$rcc[0]); $t->setcc(POSIX::VTIME(),$rcc[1]);
croak("${RESET}tcsetattr: $!\n")
unless defined($t->setattr(0,POSIX::TCSANOW()));
}
sub wait_for_bit_set($$) # wait for state
{
my($id,$trgbit) = @_;
for (my($time) = 0; ($rcv_state[$id]&$trgbit)==0; $time+=$naptime) {
croak("$COLOR[$id]Error: timeout waiting for instrument $id" .
"$RESET set status bit $trgbit (status is $rcv_state[$id])\n")
if ($time >= $timeout);
select(undef,undef,undef,$naptime);
}
}
sub wait_for_bit_cleared($$) # wait for state
{
my($id,$trgbit) = @_;
for (my($time) = 0; ($rcv_state[$id]&$trgbit)==$trgbit; $time+=$naptime) {
croak("$COLOR[$id]Error: timeout waiting for instrument $id" .
"$RESET clear status bit $trgbit (status is $rcv_state[$id])\n")
if ($time >= $timeout);
select(undef,undef,undef,$naptime);
}
}
sub send_BREAK($) # send simple BREAK
{
my($id) = @_;
print(STDERR "$COLOR[$id]\{BREAK INSTRUMENT $id}") unless ($opt_s);
croak("$COLOR[$id]tcsendbreak: $!$RESET\n")
unless defined(POSIX::tcsendbreak($sfd[$id],0));
$rcv_state[$id] |= $SET_DEFAULT_SPEED; # ECHO or UPLOAD
}
sub help() # print help message
{
my($toggle) = "^T: toggle instrument; " if defined($TTY1);
print($COLOR[$cid]);
print(STDERR "\n$COLOR[$cid]Instrument $cid ($COMMS_SPEED[$cid]bps)\n$COLOR[$cid]^H: help; " .
"$toggle^C: BREAK; ^U: upload; ^X: download; ^S: shell; " .
"^B: change baud rate; ^D: end\n");
}
sub next_cmd($) # get next cmd from file
{
my($f) = @_;
while (defined($_ = <$f>)) {
chomp;
s/\s*;.*//; # remove comments
next if /^\s*$/; # empty lines
return $_;
}
return undef;
}
$cid = 0; # current instrument
rawmode(); # setup
help();
KEYSTROKE: while (POSIX::read(0,$buf,1)) { # main tty-writer loop
$char = unpack('C',$buf);
#-------------------------
# HANDLE ^B (CHANGE SPEED)
#-------------------------
if ($char == 2) {
if ($rcv_state[$cid] == $ECHO) {
$DEFAULT_SPEED[$cid] *= 2;
$DEFAULT_SPEED[$cid] = 57600 if ($DEFAULT_SPEED[$cid] == 76800);
$DEFAULT_SPEED[$cid] = 300 if ($DEFAULT_SPEED[$cid] == 230400);
$DEFAULT_SPEED[$cid] = 1200 if ($DEFAULT_SPEED[$cid] == 600);
POSIX::write($sfd[$cid],"\r$RDI_SPEED{$DEFAULT_SPEED[$cid]}11\r",7);
sleep(1);
$rcv_state[$cid] |= $SET_DEFAULT_SPEED;
wait_for_bit_cleared($cid,$SET_DEFAULT_SPEED);
} else {
print(STDERR "$COLOR[$cid]\{Can only change speed while in ECHO mode}") unless ($opt_s);
}
help();
}
#-----------------------
# HANDLE ^C (SEND BREAK)
#-----------------------
elsif ($char == 3) {
my($cidkilled) = 0;
if (($rcv_state[0]&$DOWNLOAD) || # currently downloading
($rcv_state[1]&$DOWNLOAD)) {
if ($rcv_state[$cid]&$DOWNLOAD) { # active-instrument downloading
print(STDERR "$COLOR[$cid]\{KILLING PID $dld_pid[$cid]}") unless ($opt_s);
send_BREAK($cid); kill('TERM',$dld_pid[$cid]);
wait_for_bit_cleared($cid,$SET_DEFAULT_SPEED);
send_BREAK($cid); kill('TERM',$dld_pid[$cid]);
$cidkilled = 1;
}
if ($rcv_state[!$cid]&$DOWNLOAD) { # inactive-instrument dld'ing
if ($cidkilled) { # active killed as well
$tmp = $rcv_state[$cid]&~$ECHO; $rcv_state[$cid] = $tmp|$BUFFER;
$cid = 1*!$cid; # toggle instruments
$tmp = $rcv_state[$cid]&~$BUFFER; $rcv_state[$cid] = $tmp|$FLUSH;
wait_for_bit_cleared($cid,$FLUSH); # flush before killing
print(STDERR "$COLOR[$cid]\{KILLING PID $dld_pid[$cid]}") unless ($opt_s);
send_BREAK($cid); kill('TERM',$dld_pid[$cid]);
wait_for_bit_cleared($cid,$SET_DEFAULT_SPEED);
send_BREAK($cid);
wait_for_bit_cleared($cid,$SET_DEFAULT_SPEED);
$tmp = $rcv_state[$cid]&~$ECHO; $rcv_state[$cid] = $tmp|$BUFFER;
$cid = 1*!$cid; # toggle back
$tmp = $rcv_state[$cid]&~$BUFFER; $rcv_state[$cid] = $tmp|$FLUSH;
wait_for_bit_cleared($cid,$FLUSH);
} else { # tried to send BREAK
if ($cid == 0) { # while inactive dld'ing
printf(STDERR "$COLOR[0]\{REFUSE TO SEND BREAK -$COLOR[1]- " .
"INSTRUMENT 1 DOWNLOAD IN PROGRESS}\n");
} else {
printf(STDERR "$COLOR[1]\{REFUSE TO SEND BREAK -$COLOR[0]- " .
"INSTRUMENT 1 DOWNLOAD IN PROGRESS}\n");
}
}
}
} else { # none downloading
send_BREAK($cid); # send BREAK
wait_for_bit_cleared($cid,$SET_DEFAULT_SPEED);
}
}
#-----------------
# HANDLE ^D (EXIT)
#-----------------
elsif ($char == 4) {
if (($rcv_state[0]&$DOWNLOAD)|($rcv_state[1]&$DOWNLOAD)) {
print(STDERR "$COLOR[$cid]\{DOWNLOAD(S) IN PROGRESS --- ^C TO ABORT}\n");
} else {
last;
}
}
#-----------------
# HANDLE ^H (HELP)
#-----------------
elsif ($char == 8) { help(); }
#-------------------------
# HANDLE ^S (SHELL ESCAPE)
#-------------------------
elsif ($char == 19) {
$tmp = $rcv_state[$cid]&~$ECHO; $rcv_state[$cid] = $tmp|$BUFFER;
print($RESET);
cookedmode();
system($shell) && print(STDERR "$shell: $!");
rawmode(); help();
$tmp = $rcv_state[$cid]&~$BUFFER; $rcv_state[$cid] = $tmp|$FLUSH;
wait_for_bit_cleared($cid,$FLUSH);
}
#-------------------------------
# HANDLE ^T (TOGGLE INSTRUMENTS)
#-------------------------------
elsif ($char == 20 && defined($TTY1)) {
$tmp = $rcv_state[$cid]&~$ECHO; $rcv_state[$cid] = $tmp|$BUFFER;
$cid = 1*!$cid; print("\n");
help();
$tmp = $rcv_state[$cid]&~$BUFFER; $rcv_state[$cid] = $tmp|$FLUSH;
wait_for_bit_cleared($cid,$FLUSH);
}
#----------------------------
# HANDLE ^U (UPLOAD CMD-FILE)
#----------------------------
elsif ($char == 21) {
if ($rcv_state[$cid]&$DOWNLOAD){
print(STDERR "$COLOR[$cid]\{DOWNLOAD IN PROGRESS --- ^C TO ABORT}\n");
} else {
unless ($opt_R) {
$tmp = $rcv_state[$cid]&~$ECHO; $rcv_state[$cid] = $tmp|$BUFFER;
}
print($RESET);
cookedmode();
do {
print("\nCommand File: "); chomp($_ = <STDIN>);
if ($_ eq '') { # no file name given
print("{upload canceled}\n");
rawmode();
unless ($opt_R) {
$tmp = $rcv_state[$cid]&~$BUFFER; $rcv_state[$cid] = $tmp|$FLUSH;
wait_for_bit_cleared($cid,$FLUSH);
}
next KEYSTROKE;
}
unless (open(CF,$_)) {
print("$_: $!");
redo;
}
} while (0);
rawmode();
if ($opt_R) { # non-RDI mode: dump entire file contents raw
my($buf,$nread);
while (($nread = read(CF,$buf,1)) > 0) { # nice small chunks
POSIX::write($sfd[$cid],$buf,$nread);
}
} else { # RDI mode: parse command file and send command by command
$tmp = $rcv_state[$cid]&~$BUFFER; $rcv_state[$cid] = $tmp|$FLUSH;
wait_for_bit_cleared($cid,$FLUSH);
my($cmd) = next_cmd(CF); # read ahead (last cmd may ...
my($next_cmd); # ... not generate prompt)
while (defined($next_cmd = next_cmd(CF))) {
$rcv_state[$cid] = $UPLOAD;
if ($cmd eq '<BREAK>') {
send_BREAK($cid);
} else {
POSIX::write($sfd[$cid],"$cmd\r",length($cmd)+1);
}
$cmd = $next_cmd;
wait_for_bit_set($cid,$ECHO); # NOT SURE!!!
$tmp = $rcv_state[$cid]&~$ECHO; $rcv_state[$cid] = $tmp|$BUFFER;
print("\n${RESET}{upload finished}\n");
$tmp = $rcv_state[$cid]&~$BUFFER; $rcv_state[$cid] = $tmp|$FLUSH;
wait_for_bit_cleared($cid,$FLUSH);
}
}
close(CF);
}
}
#--------------------------
# HANDLE ^X (DOWNLOAD DATA)
#--------------------------
elsif ($char == 24) {
if (defined($receive_ymodem)) {
if ($rcv_state[$cid]&$DOWNLOAD){
print(STDERR "$COLOR[$cid]\{DOWNLOAD IN PROGRESS --- ^C TO ABORT}\n");
} else {
$rcv_state[$cid] = $SET_DOWNLOAD_SPEED;
wait_for_bit_set($cid,$ECHO);
$rcv_state[$cid] = $DOWNLOAD; # start waiting for instr. ready
POSIX::write($sfd[$cid],"$START_DOWNLOAD_RDI_COMMAND\r",
length($START_DOWNLOAD_RDI_COMMAND)+1);
wait_for_bit_set($cid,$ECHO);
}
} else {
print(STDERR "$COLOR[$cid]\{NO YMODEM RECEIVER PROGRAM SPECIFIED}\n");
}
}
#------------------------------------------------------------------
# (FINALLY) HANDLE DEFAULT CASE: ECHO KEYBOARD INPUT TO SERIAL PORT
#------------------------------------------------------------------
else { POSIX::write($sfd[$cid],$buf,1); }
}
#-------------------
# Exit Received (^D)
#-------------------
if ($rcv_state[0]&$DOWNLOAD) { # abort downloads on close
send_BREAK(0); kill('TERM',$dld_pid[0]);
wait_for_bit_cleared(0,$SET_DEFAULT_SPEED);
send_BREAK(0);
wait_for_bit_cleared(0,$SET_DEFAULT_SPEED);
}
if ($rcv_state[1]&$DOWNLOAD) {
send_BREAK(1); kill('TERM',$dld_pid[1]);
wait_for_bit_cleared(1,$SET_DEFAULT_SPEED);
send_BREAK(1);
wait_for_bit_cleared(1,$SET_DEFAULT_SPEED);
}
$rcv_state[0] = $rcv_state[1] = $SHUTDOWN; # tell receivers to stop
$TTY_receiver[0]->join(); # wait for them
$TTY_receiver[1]->join() if defined($TTY1);
cookedmode(); # reset keyboard
print("$RESET\n"); # and screen
exit(0);