123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278 |
-
-
-
-
- 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;
-
-
-
-
-
-
-
- sub parse_opts {
-
- my $o = {
- verbosity => 1,
- rcfile => 'bochsrc.txt',
- };
-
- my $opt_handlers = {
- verbose => sub { $o->{verbosity}++; },
- quiet => sub { $o->{verbosity}--; },
- help => sub { pod2usage(1); },
- norcfile => sub { delete $o->{rcfile}; },
- };
-
- $o->{$_} = $opt_handlers->{$_} foreach keys %$opt_handlers;
-
- my @optspec = ( 'help|h|?',
- 'quiet|q+',
- 'verbose|v+',
- 'log|l=s',
- 'rcfile|r=s',
- 'norcfile',
- );
-
- Getopt::Long::Configure ( 'bundling' );
- pod2usage("Error parsing command-line options") unless GetOptions (
- $o, @optspec );
-
- delete $o->{$_} foreach keys %$opt_handlers;
- return $o;
- }
-
-
-
-
-
- sub patch_bochsrc {
- my $active = shift;
- my $pty = shift;
-
-
- ( 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";
-
-
- my $patch = "com1: enabled=1, dev=$pty\n";
-
-
- 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";
-
-
-
-
-
-
-
-
-
-
-
-
- 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;
- }
-
-
-
-
-
- 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;
- }
-
-
-
-
-
- $o = parse_opts();
- pod2usage(1) if @ARGV;
-
-
- my $sigdie = sub { die "Exiting via signal\n"; };
- $SIG{INT} = $sigdie;
-
-
- my $pty = IO::Pty->new();
- $pty->close_slave();
- $pty->set_raw();
- print STDERR "Slave pty is ".$pty->ttyname."\n" if $o->{verbosity} >= 1;
-
-
- my $log;
- if ( $o->{log} ) {
- open $log, ">$o->{log}" or die "Could not open $o->{log}: $!\n";
- }
-
-
- 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->setattr ( fileno(STDIN), TCSANOW );
- }
-
-
- $restore_file = { $o->{rcfile} =>
- patch_bochsrc ( $o->{rcfile}, $pty->ttyname ) }
- if $o->{rcfile};
-
-
- 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 ) ) {
-
- bochs_attached() if $attached == 0;
- $attached = 1;
- syswrite ( STDOUT, $data );
- $log->syswrite ( $data ) if $log;
- } else {
-
-
- bochs_detached() if $attached == 1;
- $attached = 0;
- sleep ( 1 );
- }
- } else {
- bochs_attached() if $attached == 0;
- $attached = 1;
- }
- }
-
- END {
-
- if ( ( my $orig_file, my $backup_file ) = %$restore_file ) {
- unlink $orig_file;
- rename $backup_file, $orig_file;
- }
-
- if ( $restore_termios ) {
- $restore_termios->setattr ( fileno(STDIN), TCSANOW );
- }
- }
|