![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to serial-console CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Qemu by Fabrice Bellard] / qemu / roms / ipxe / contrib / vm|
Return to serial-console CVS log | Up to [Qemu by Fabrice Bellard] / qemu / roms / ipxe / contrib / vm |
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.