Return to serial-console CVS log

Up to [Qemu by Fabrice Bellard] / qemu / roms / ipxe / contrib / vm

Annotation of qemu/roms/ipxe/contrib/vm/serial-console, revision 1.1

1.1     ! root        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: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.