[fdt] Add ability to parse a MAC address from a flattened device tree
[ipxe.git] / contrib / vm / 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 }