#!/usr/bin/perl -w
=head1 NAME
serial-console
=head1 SYNOPSIS
serial-console [options]
Options:
-h,--help Display brief help message
-v,--verbose Increase verbosity
-q,--quiet Decrease verbosity
-l,--log FILE Log output to file
-r,--rcfile FILE Modify specified bochsrc file
=head1 DESCRIPTION
C<serial-console> provides a virtual serial console for use with
Bochs. Running C<serial-console> creates a pseudo-tty. The master
side of this pty is made available to the user for interaction; the
slave device is written to the Bochs configuration file
(C<bochsrc.txt>) for use by a subsequent Bochs session.
=head1 EXAMPLES
=over 4
=item C<serial-console>
Create a virtual serial console for Bochs, modify C<bochsrc.txt>
appropriately.
=item C<serial-console -r ../.bochsrc -l serial.log>
Create a virtual serial console for Bochs, modify C<../.bochsrc>
appropriately, log output to C<serial.log>.
=back
=head1 INVOCATION
Before starting Bochs, run C<serial-console> in a different session
(e.g. a different xterm window). When you subsequently start Bochs,
anything that the emulated machine writes to its serial port will
appear in the window running C<serial-console>, and anything typed in
the C<serial-console> window will arrive on the emulated machine's
serial port.
You do B<not> need to rerun C<serial-console> afresh for each Bochs
session.
=head1 OPTIONS
=over 4
=item B<-l,--log FILE>
Log all output (i.e. everything that is printed in the
C<serial-console> window) to the specified file.
=item B<-r,--rcfile FILE>
Modify the specified bochsrc file. The file will be updated to
contain the path to the slave side of the psuedo tty that we create.
The original file will be restored when C<serial-console> exits. The
default is to modify the file C<bochsrc.txt> in the current directory.
To avoid modifying any bochsrc file, use C<--norcfile>.
=back
=cut
use IO::Pty;
use IO::Select;
use File::Spec::Functions qw ( :ALL );
use Getopt::Long;
use Pod::Usage;
use POSIX qw ( :termios_h );
use strict;
use warnings;
my $o;
my $restore_file = {};
my $restore_termios;
use constant BLOCKSIZE => 8192;
##############################################################################
#
# Parse command line options into options hash ($o)
#
# $o = parse_opts();
sub parse_opts {
# $o is the hash that will hold the options
my $o = {
verbosity => 1,
rcfile => 'bochsrc.txt',
};
# Special handlers for some options
my $opt_handlers = {
verbose => sub { $o->{verbosity}++; },
quiet => sub { $o->{verbosity}--; },
help => sub { pod2usage(1); },
norcfile => sub { delete $o->{rcfile}; },
};
# Merge handlers into main options hash (so that Getopt::Long can find them)
$o->{$_} = $opt_handlers->{$_} foreach keys %$opt_handlers;
# Option specifiers for Getopt::Long
my @optspec = ( 'help|h|?',
'quiet|q+',
'verbose|v+',
'log|l=s',
'rcfile|r=s',
'norcfile',
);
# Do option parsing
Getopt::Long::Configure ( 'bundling' );
pod2usage("Error parsing command-line options") unless GetOptions (
$o, @optspec );
# Clean up $o by removing the handlers
delete $o->{$_} foreach keys %$opt_handlers;
return $o;
}
##############################################################################
#
# Modify bochsrc file
sub patch_bochsrc {
my $active = shift;
my $pty = shift;
# Rename active file to backup file
( my $vol, my $dir, my $file ) = splitpath ( $active );
$file = '.'.$file.".serial-console";
my $backup = catpath ( $vol, $dir, $file );
rename $active, $backup
or die "Could not back up $active to $backup: $!\n";
# Derive line to be inserted
my $patch = "com1: enabled=1, mode=term, dev=$pty\n";
# Modify file
open my $old, "<$backup" or die "Could not open $backup: $!\n";
open my $new, ">$active" or die "Could not open $active: $!\n";
print $new <<"EOF";
##################################################
#
# This file has been modified by serial-console.
#
# Do not modify this file; it will be erased when
# serial-console (pid $$) exits and will be
# replaced with the backup copy held in
# $backup.
#
##################################################
EOF
my $patched;
while ( my $line = <$old> ) {
if ( $line =~ /^\s*\#?\s*com1:\s*\S/ ) {
if ( ! $patched ) {
$line = $patch;
$patched = 1;
} else {
$line = '# '.$line unless $line =~ /^\s*\#/;
}
}
print $new $line;
}
print $new $patch unless $patched;
close $old;
close $new;
return $backup;
}
##############################################################################
#
# Attach/detach message printing and terminal settings
sub bochs_attached {
print STDERR "Bochs attached.\n\n\n"
if $o->{verbosity} >= 1;
}
sub bochs_detached {
print STDERR "\n\nWaiting for bochs to attach...\n"
if $o->{verbosity} >= 1;
}
##############################################################################
#
# Main program
$o = parse_opts();
pod2usage(1) if @ARGV;
# Catch signals
my $sigdie = sub { die "Exiting via signal\n"; };
$SIG{INT} = $sigdie;
# Create Pty, close slave side
my $pty = IO::Pty->new();
$pty->close_slave();
$pty->set_raw();
print STDERR "Slave pty is ".$pty->ttyname."\n" if $o->{verbosity} >= 1;
# Open logfile
my $log;
if ( $o->{log} ) {
open $log, ">$o->{log}" or die "Could not open $o->{log}: $!\n";
}
# Set up terminal
my $termios;
if ( -t STDIN ) {
$termios = POSIX::Termios->new;
$restore_termios = POSIX::Termios->new;
$termios->getattr ( fileno(STDIN) );
$restore_termios->getattr ( fileno(STDIN) );
$termios->setlflag ( $termios->getlflag & ~(ICANON) & ~(ECHO) );
$termios->setiflag ( $termios->getiflag & ~(ICRNL) );
$termios->setattr ( fileno(STDIN), TCSANOW );
}
# Modify bochsrc file
$restore_file = { $o->{rcfile} =>
patch_bochsrc ( $o->{rcfile}, $pty->ttyname ) }
if $o->{rcfile};
# Start character shunt
my $attached = 1;
my $select = IO::Select->new ( \*STDIN, $pty );
while ( 1 ) {
my %can_read = map { $_ => 1 }
$select->can_read ( $attached ? undef : 1 );
if ( $can_read{\*STDIN} ) {
sysread ( STDIN, my $data, BLOCKSIZE )
or die "Cannot read from STDIN: $!\n";
$pty->syswrite ( $data );
}
if ( $can_read{$pty} ) {
if ( $pty->sysread ( my $data, BLOCKSIZE ) ) {
# Actual data available
bochs_attached() if $attached == 0;
$attached = 1;
syswrite ( STDOUT, $data );
$log->syswrite ( $data ) if $log;
} else {
# No data available but select() says we can read. This almost
# certainly indicates that nothing is attached to the slave.
bochs_detached() if $attached == 1;
$attached = 0;
sleep ( 1 );
}
} else {
bochs_attached() if $attached == 0;
$attached = 1;
}
}
END {
# Restore bochsrc file if applicable
if ( ( my $orig_file, my $backup_file ) = %$restore_file ) {
unlink $orig_file;
rename $backup_file, $orig_file;
}
# Restore terminal settings if applicable
if ( $restore_termios ) {
$restore_termios->setattr ( fileno(STDIN), TCSANOW );
}
}
