contrib/bochs/serial-console

   1 #!/usr/bin/perl -w
   2
   3 =head1 NAME
   4
   5 serial-console
   6
   7 =head1 SYNOPSIS
   8
   9 serial-console [options]
  10
  11 Options:
  12
  13     -h,--help         Display brief help message
  14     -v,--verbose      Increase verbosity
  15     -q,--quiet        Decrease verbosity
  16     -l,--log FILE     Log output to file
  17     -r,--rcfile FILE  Modify specified bochsrc file
  18
  19 =head1 DESCRIPTION
  20
  21 C<serial-console> provides a virtual serial console for use with
  22 Bochs.  Running C<serial-console> creates a pseudo-tty.  The master
  23 side of this pty is made available to the user for interaction; the
  24 slave device is written to the Bochs configuration file
  25 (C<bochsrc.txt>) for use by a subsequent Bochs session.
  26
  27 =head1 EXAMPLES
  28
  29 =over 4
  30
  31 =item C<serial-console>
  32
  33 Create a virtual serial console for Bochs, modify C<bochsrc.txt>
  34 appropriately.
  35
  36 =item C<serial-console -r ../.bochsrc -l serial.log>
  37
  38 Create a virtual serial console for Bochs, modify C<../.bochsrc>
  39 appropriately, log output to C<serial.log>.
  40
  41 =back
  42
  43 =head1 INVOCATION
  44
  45 Before starting Bochs, run C<serial-console> in a different session
  46 (e.g. a different xterm window).  When you subsequently start Bochs,
  47 anything that the emulated machine writes to its serial port will
  48 appear in the window running C<serial-console>, and anything typed in
  49 the C<serial-console> window will arrive on the emulated machine's
  50 serial port.
  51
  52 You do B<not> need to rerun C<serial-console> afresh for each Bochs
  53 session.
  54
  55 =head1 OPTIONS
  56
  57 =over 4
  58
  59 =item B<-l,--log FILE>
  60
  61 Log all output (i.e. everything that is printed in the
  62 C<serial-console> window) to the specified file.
  63
  64 =item B<-r,--rcfile FILE>
  65
  66 Modify the specified bochsrc file.  The file will be updated to
  67 contain the path to the slave side of the psuedo tty that we create.
  68 The original file will be restored when C<serial-console> exits.  The
  69 default is to modify the file C<bochsrc.txt> in the current directory.
  70
  71 To avoid modifying any bochsrc file, use C<--norcfile>.
  72
  73 =back
  74
  75 =cut
  76
  77 use IO::Pty;
  78 use IO::Select;
  79 use File::Spec::Functions qw ( :ALL );
  80 use Getopt::Long;
  81 use Pod::Usage;
  82 use POSIX qw ( :termios_h );
  83 use strict;
  84 use warnings;
  85
  86 my $o;
  87 my $restore_file = {};
  88 my $restore_termios;
  89 use constant BLOCKSIZE => 8192;
  90
  91 ##############################################################################
  92 #
  93 # Parse command line options into options hash ($o)
  94 #
  95 # $o = parse_opts();
  96
  97 sub parse_opts {
  98   # $o is the hash that will hold the options
  99   my $o = {
 100     verbosity => 1,
 101     rcfile => 'bochsrc.txt',
 102   };
 103   # Special handlers for some options
 104   my $opt_handlers = {
 105     verbose => sub { $o->{verbosity}++; },
 106     quiet => sub { $o->{verbosity}--; },
 107     help => sub { pod2usage(1); },
 108     norcfile => sub { delete $o->{rcfile}; },
 109   };
 110   # Merge handlers into main options hash (so that Getopt::Long can find them)
 111   $o->{$_} = $opt_handlers->{$_} foreach keys %$opt_handlers;
 112   # Option specifiers for Getopt::Long
 113   my @optspec = ( 'help|h|?',
 114                   'quiet|q+',
 115                   'verbose|v+',
 116                   'log|l=s',
 117                   'rcfile|r=s',
 118                   'norcfile',
 119                   );
 120   # Do option parsing
 121   Getopt::Long::Configure ( 'bundling' );
 122   pod2usage("Error parsing command-line options") unless GetOptions (
 123   $o, @optspec );
 124   # Clean up $o by removing the handlers
 125   delete $o->{$_} foreach keys %$opt_handlers;
 126   return $o;
 127 }
 128
 129 ##############################################################################
 130 #
 131 # Modify bochsrc file
 132
 133 sub patch_bochsrc {
 134   my $active = shift;
 135   my $pty = shift;
 136
 137   # Rename active file to backup file
 138   ( my $vol, my $dir, my $file ) = splitpath ( $active );
 139   $file = '.'.$file.".serial-console";
 140   my $backup = catpath ( $vol, $dir, $file );
 141   rename $active, $backup
 142       or die "Could not back up $active to $backup: $!\n";
 143
 144   # Derive line to be inserted
 145   my $patch = "com1: enabled=1, mode=term, dev=$pty\n";
 146
 147   # Modify file
 148   open my $old, "<$backup" or die "Could not open $backup: $!\n";
 149   open my $new, ">$active" or die "Could not open $active: $!\n";
 150   print $new <<"EOF";
 151 ##################################################
 152 #
 153 # This file has been modified by serial-console.
 154 #
 155 # Do not modify this file; it will be erased when
 156 # serial-console (pid $$) exits and will be
 157 # replaced with the backup copy held in
 158 # $backup.
 159 #
 160 ##################################################
 161
 162
 163 EOF
 164   my $patched;
 165   while ( my $line = <$old> ) {
 166     if ( $line =~ /^\s*\#?\s*com1:\s*\S/ ) {
 167       if ( ! $patched ) {
 168         $line = $patch;
 169         $patched = 1;
 170       } else {
 171         $line = '# '.$line unless $line =~ /^\s*\#/;
 172       }
 173     }
 174     print $new $line;
 175   }
 176   print $new $patch unless $patched;
 177   close $old;
 178   close $new;
 179
 180   return $backup;
 181 }
 182
 183 ##############################################################################
 184 #
 185 # Attach/detach message printing and terminal settings
 186
 187 sub bochs_attached {
 188   print STDERR "Bochs attached.\n\n\n"
 189       if $o->{verbosity} >= 1;
 190 }
 191
 192 sub bochs_detached {
 193   print STDERR "\n\nWaiting for bochs to attach...\n"
 194       if $o->{verbosity} >= 1;
 195 }
 196
 197 ##############################################################################
 198 #
 199 # Main program
 200
 201 $o = parse_opts();
 202 pod2usage(1) if @ARGV;
 203
 204 # Catch signals
 205 my $sigdie = sub { die "Exiting via signal\n"; };
 206 $SIG{INT} = $sigdie;
 207
 208 # Create Pty, close slave side
 209 my $pty = IO::Pty->new();
 210 $pty->close_slave();
 211 $pty->set_raw();
 212 print STDERR "Slave pty is ".$pty->ttyname."\n" if $o->{verbosity} >= 1;
 213
 214 # Open logfile
 215 my $log;
 216 if ( $o->{log} ) {
 217   open $log, ">$o->{log}" or die "Could not open $o->{log}: $!\n";
 218 }
 219
 220 # Set up terminal
 221 my $termios;
 222 if ( -t STDIN ) {
 223   $termios = POSIX::Termios->new;
 224   $restore_termios = POSIX::Termios->new;
 225   $termios->getattr ( fileno(STDIN) );
 226   $restore_termios->getattr ( fileno(STDIN) );
 227   $termios->setlflag ( $termios->getlflag & ~(ICANON) & ~(ECHO) );
 228   $termios->setiflag ( $termios->getiflag & ~(ICRNL) );
 229   $termios->setattr ( fileno(STDIN), TCSANOW );
 230 }
 231
 232 # Modify bochsrc file
 233 $restore_file = { $o->{rcfile} =>
 234                   patch_bochsrc ( $o->{rcfile}, $pty->ttyname ) }
 235     if $o->{rcfile};
 236
 237 # Start character shunt
 238 my $attached = 1;
 239 my $select = IO::Select->new ( \*STDIN, $pty );
 240 while ( 1 ) {
 241   my %can_read = map { $_ => 1 }
 242                      $select->can_read ( $attached ? undef : 1 );
 243   if ( $can_read{\*STDIN} ) {
 244     sysread ( STDIN, my $data, BLOCKSIZE )
 245         or die "Cannot read from STDIN: $!\n";
 246     $pty->syswrite ( $data );
 247   }
 248   if ( $can_read{$pty} ) {
 249     if ( $pty->sysread ( my $data, BLOCKSIZE ) ) {
 250       # Actual data available
 251       bochs_attached() if $attached == 0;
 252       $attached = 1;
 253       syswrite ( STDOUT, $data );
 254       $log->syswrite ( $data ) if $log;
 255     } else {
 256       # No data available but select() says we can read.  This almost
 257       # certainly indicates that nothing is attached to the slave.
 258       bochs_detached() if $attached == 1;
 259       $attached = 0;
 260       sleep ( 1 );
 261     }
 262   } else {
 263     bochs_attached() if $attached == 0;
 264     $attached = 1;
 265   }
 266 }
 267
 268 END {
 269   # Restore bochsrc file if applicable
 270   if ( ( my $orig_file, my $backup_file ) = %$restore_file ) {
 271     unlink $orig_file;
 272     rename $backup_file, $orig_file;
 273   }
 274   # Restore terminal settings if applicable
 275   if ( $restore_termios ) {
 276     $restore_termios->setattr ( fileno(STDIN), TCSANOW );
 277   }
 278 }