--- /dev/null
+#!/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 );
+ }
+}
Code Review / kvmfornfv.git / blobdiff