[novaboot.git] / novaboot

#!/usr/bin/perl -w

# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

use strict;
use warnings;
use warnings (exists $ENV{NOVABOOT_TEST} ? (FATAL => 'all') : ());
use Getopt::Long qw(GetOptionsFromString);
use Pod::Usage;
use File::Basename;
use File::Spec;
use IO::Handle;
use Time::HiRes("usleep");
use Socket;
use FileHandle;
use IPC::Open2;
use POSIX qw(:errno_h);
use Cwd qw(getcwd abs_path);
use Expect;

# always flush
$| = 1;

my $invocation_dir = getcwd();

## Configuration file handling

# Default configuration
$CFG::hypervisor = "";
$CFG::hypervisor_params = "serial";
$CFG::genisoimage = "genisoimage";
$CFG::qemu = 'qemu -cpu coreduo -smp 2';
%CFG::targets = (
    "tud" => '--server=erwin.inf.tu-dresden.de:~sojka/boot/novaboot --rsync-flags="--chmod=Dg+s,ug+w,o-w,+rX --rsync-path=\"umask 002 && rsync\"" --grub --grub-prefix=(nd)/tftpboot/sojka/novaboot --grub-preamble="timeout 0" --concat --iprelay=141.76.48.80:2324 --scriptmod=s/\\\\bhostserial\\\\b/hostserialpci/g',
    "novabox" => '--server=rtime.felk.cvut.cz:/srv/tftp/novaboot --rsync-flags="--chmod=Dg+s,ug+w,o-w,+rX --rsync-path=\"umask 002 && rsync\"" --pulsar --iprelay=147.32.86.92:2324',
    "localhost" => '--scriptmod=s/console=tty[A-Z0-9,]+// --server=/boot/novaboot/$NAME --grub2 --grub-prefix=/boot/novaboot/$NAME --grub2-prolog="  set root=\'(hd0,msdos1)\'"',
    );
$CFG::scons = "scons -j2";

my $builddir;

sub read_config($) {
    my ($cfg) = @_;
    {
        package CFG; # Put config data into a separate namespace
        my $rc = do($cfg);

        # Check for errors
        if ($@) {
            die("ERROR: Failure compiling '$cfg' - $@");
        } elsif (! defined($rc)) {
            die("ERROR: Failure reading '$cfg' - $!");
        } elsif (! $rc) {
            die("ERROR: Failure processing '$cfg'");
        }
    }
    $builddir = File::Spec->rel2abs($CFG::builddir, dirname($cfg)) if defined $CFG::builddir;
    print STDERR "novaboot: Read $cfg\n";
}

my @cfgs;
{
    # We don't use $0 here, because it points to the novaboot itself and
    # not to the novaboot script. The problem with this approach is that
    # when a script is run as "novaboot <options> <script>" then $ARGV[0]
    # contains the first option. Hence the -f check.
    my $dir = File::Spec->rel2abs($ARGV[0] && -f $ARGV[0] ? dirname($ARGV[0]) : '', $invocation_dir);
    while (-d $dir && $dir ne "/") {
        push @cfgs, "$dir/.novaboot" if -r "$dir/.novaboot";
        $dir = abs_path($dir."/..");
    }
}
my $cfg = $ENV{'NOVABOOT_CONFIG'};
Getopt::Long::Configure(qw/no_ignore_case pass_through/);
GetOptions ("config|c=s" => \$cfg);
read_config($_) foreach $cfg or reverse @cfgs;

## Command line handling

my ($append, $bender, @chainloaders, $concat, $config_name_opt, $dhcp_tftp, $dump_opt, $dump_config, $gen_only, $grub_config, $grub_prefix, $grub_preamble, $grub2_prolog, $grub2_config, $help, $iprelay, $iso_image, $man, $no_file_gen, $off_opt, $on_opt, $pulsar, $pulsar_root, $qemu, $qemu_append, $qemu_flags_cmd, $remote_cmd, $reset_cmd, $rom_prefix, $rsync_flags, @scriptmod, $scons, $serial, $server, $stty, $uboot, $uboot_init);

$rsync_flags = '';
$rom_prefix = 'rom://';
$stty = 'raw -crtscts -onlcr 115200';

Getopt::Long::Configure(qw/no_ignore_case no_pass_through/);
my %opt_spec;
%opt_spec = (
    "append|a=s"     => \$append,
    "bender|b"       => \$bender,
    "build-dir=s"    => sub { my ($n, $v) = @_; $builddir = File::Spec->rel2abs($v); },
    "concat"         => \$concat,
    "chainloader=s"  => \@chainloaders,
    "dhcp-tftp|d"    => \$dhcp_tftp,
    "dump"           => \$dump_opt,
    "dump-config"    => \$dump_config,
    "gen-only"       => \$gen_only,
    "grub|g:s"       => \$grub_config,
    "grub-preamble=s"=> \$grub_preamble,
    "grub-prefix=s"  => \$grub_prefix,
    "grub2:s"        => \$grub2_config,
    "grub2-prolog=s" => \$grub2_prolog,
    "iprelay=s"      => \$iprelay,
    "iso|i:s"        => \$iso_image,
    "name=s"         => \$config_name_opt,
    "no-file-gen"    => \$no_file_gen,
    "off"            => \$off_opt,
    "on"             => \$on_opt,
    "pulsar|p:s"     => \$pulsar,
    "pulsar-root=s"  => \$pulsar_root,
    "qemu|Q=s"       => \$qemu,
    "qemu-append=s"  => \$qemu_append,
    "qemu-flags|q=s" => \$qemu_flags_cmd,
    "remote-cmd=s"   => \$remote_cmd,
    "reset-cmd=s"    => \$reset_cmd,
    "rsync-flags=s"  => \$rsync_flags,
    "scons:s"        => \$scons,
    "scriptmod=s"    => \@scriptmod,
    "serial|s:s"     => \$serial,
    "server:s"       => \$server,
    "strip-rom"      => sub { $rom_prefix = ''; },
    "stty=s"         => \$stty,
    "target|t=s"     => sub { my ($opt_name, $opt_value) = @_;
                              exists $CFG::targets{$opt_value} or die("Unknown target '$opt_value' (valid targets are: ".join(", ", sort keys(%CFG::targets)).")");
                              GetOptionsFromString($CFG::targets{$opt_value}, %opt_spec); },
    "uboot"          => \$uboot,
    "h"              => \$help,
    "help"           => \$man,
    );
GetOptions %opt_spec or pod2usage(2);
pod2usage(1) if $help;
pod2usage(-exitstatus => 0, -verbose => 2) if $man;

### Dump sanitized configuration (if requested)

if ($dump_config) {
    use Data::Dumper;
    $Data::Dumper::Indent=1;
    print "# This file is in perl syntax.\n";
    foreach my $key(sort(keys(%CFG::))) { # See "Symbol Tables" in perlmod(1)
        if (defined ${$CFG::{$key}}) { print Data::Dumper->Dump([${$CFG::{$key}}], ["*$key"]); }
        if (        @{$CFG::{$key}}) { print Data::Dumper->Dump([\@{$CFG::{$key}}], ["*$key"]); }
        if (        %{$CFG::{$key}}) { print Data::Dumper->Dump([\%{$CFG::{$key}}], ["*$key"]); }
    }
    print "1;\n";
    exit;
}

### Sanitize configuration

if (defined $config_name_opt && scalar(@ARGV) > 1) { die "You cannot use --name with multiple scripts"; }

# Default options
if (defined $serial) { $serial ||= "/dev/ttyUSB0"; }
if (defined $grub_config) { $grub_config ||= "menu.lst"; }
if (defined $grub2_config) { $grub2_config ||= "grub.cfg"; }

## Parse the novaboot script(s)
my @scripts;
my $file;
my $line;
my $EOF;
my $last_fn = '';
my ($modules, $variables, $generated, $continuation);
while (<>) {
    if ($ARGV ne $last_fn) { # New script
        die "Missing EOF in $last_fn" if $file;
        die "Unfinished line in $last_fn" if $line;
        $last_fn = $ARGV;
        push @scripts, { 'filename' => $ARGV,
                         'modules' => $modules = [],
                         'variables' => $variables = {},
                         'generated' => $generated = []};

    }
    chomp();
    next if /^#/ || /^\s*$/;    # Skip comments and empty lines

    foreach my $mod(@scriptmod) { eval $mod; }

    print "$_\n" if $dump_opt;

    if (/^([A-Z_]+)=(.*)$/) {   # Internal variable
        $$variables{$1} = $2;
        next;
    }
    if (/^([^ ]*)(.*?)[[:space:]]*<<([^ ]*)$/) { # Heredoc start
        push @$modules, "$1$2";
        $file = [];
        push @$generated, {filename => $1, content => $file};
        $EOF = $3;
        next;
    }
    if ($file && $_ eq $EOF) {  # Heredoc end
        undef $file;
        next;
    }
    if ($file) {                # Heredoc content
        push @{$file}, "$_\n";
        next;
    }
    $_ =~ s/^[[:space:]]*// if ($continuation);
    if (/\\$/) {                # Line continuation
        $line .= substr($_, 0, length($_)-1);
        $continuation = 1;
        next;
    }
    $continuation = 0;
    $line .= $_;
    $line .= " $append" if ($append && scalar(@$modules) == 0);

    if ($line =~ /^([^ ]*)(.*?)[[:space:]]*< ?(.*)$/) { # Command substitution
        push @$modules, "$1$2";
        push @$generated, {filename => $1, command => $3};
        $line = '';
        next;
    }
    push @$modules, $line;
    $line = '';
}
#use Data::Dumper;
#print Dumper(\@scripts);

exit if $dump_opt;

## Helper functions

sub generate_configs($$$) {
    my ($base, $generated, $filename) = @_;
    if ($base) { $base = "$base/"; };
    foreach my $g(@$generated) {
      if (exists $$g{content}) {
        my $config = $$g{content};
        my $fn = $$g{filename};
        open(my $f, '>', $fn) || die("$fn: $!");
        map { s|\brom://([^ ]*)|$rom_prefix$base$1|g; print $f "$_"; } @{$config};
        close($f);
        print "novaboot: Created $fn\n";
      } elsif (exists $$g{command} && ! $no_file_gen) {
        $ENV{SRCDIR} = dirname(File::Spec->rel2abs( $filename, $invocation_dir ));
        system_verbose("( $$g{command} ) > $$g{filename}");
      }
    }
}

sub generate_grub_config($$$$;$)
{
    my ($filename, $title, $base, $modules_ref, $preamble) = @_;
    if ($base) { $base = "$base/"; };
    open(my $fg, '>', $filename) or die "$filename: $!";
    print $fg "$preamble\n" if $preamble;
    print $fg "title $title\n" if $title;
    #print $fg "root $base\n"; # root doesn't really work for (nd)
    my $first = 1;
    foreach (@$modules_ref) {
        if ($first) {
            $first = 0;
            my ($kbin, $kcmd) = split(' ', $_, 2);
            $kcmd = '' if !defined $kcmd;
            print $fg "kernel ${base}$kbin $kcmd\n";
        } else {
            s|\brom://([^ ]*)|$rom_prefix$base$1|g; # Translate rom:// files - needed for vdisk parameter of sigma0
            print $fg "module $base$_\n";
        }
    }
    close($fg);
    print("novaboot: Created $builddir/$filename\n");
    return $filename;
}

sub generate_grub2_config($$$$;$$)
{
    my ($filename, $title, $base, $modules_ref, $preamble, $prolog) = @_;
    if ($base && substr($base,-1,1) ne '/') { $base = "$base/"; };
    open(my $fg, '>', $filename) or die "$filename: $!";
    print $fg "$preamble\n" if $preamble;
    $title ||= 'novaboot';
    print $fg "menuentry $title {\n";
    print $fg "$prolog\n" if $prolog;
    my $first = 1;
    foreach (@$modules_ref) {
        if ($first) {
            $first = 0;
            my ($kbin, $kcmd) = split(' ', $_, 2);
            $kcmd = '' if !defined $kcmd;
            print $fg "  multiboot ${base}$kbin $kcmd\n";
        } else {
            my @args = split;
            # GRUB2 doesn't pass filename in multiboot info so we have to duplicate it here
            $_ = join(' ', ($args[0], @args));
            s|\brom://|$rom_prefix|g; # We do not need to translate path for GRUB2
            print $fg "  module $base$_\n";
        }
    }
    print $fg "}\n";
    close($fg);
    print("novaboot: Created $builddir/$filename\n");
    return $filename;
}

sub generate_pulsar_config($$)
{
    my ($filename, $modules_ref) = @_;
    open(my $fg, '>', $filename) or die "$filename: $!";
    print $fg "root $pulsar_root\n" if defined $pulsar_root;
    my $first = 1;
    my ($kbin, $kcmd);
    foreach (@$modules_ref) {
        if ($first) {
            $first = 0;
            ($kbin, $kcmd) = split(' ', $_, 2);
            $kcmd = '' if !defined $kcmd;
        } else {
            my @args = split;
            s|\brom://|$rom_prefix|g;
            print $fg "load $_\n";
        }
    }
    # Put kernel as last - this is needed for booting Linux and has no influence on non-Linux OSes
    print $fg "exec $kbin $kcmd\n";
    close($fg);
    print("novaboot: Created $builddir/$filename\n");
    return $filename;
}

sub shell_cmd_string(@)
{
    return join(' ', map((/^[-_=a-zA-Z0-9\/\.\+]+$/ ? "$_" : "'$_'"), @_));
}

sub exec_verbose(@)
{
    print "novaboot: Running: ".shell_cmd_string(@_)."\n";
    exec(@_);
}

sub system_verbose($)
{
    my $cmd = shift;
    print "novaboot: Running: $cmd\n";
    my $ret = system($cmd);
    if ($ret & 0x007f) { die("Command terminated by a signal"); }
    if ($ret & 0xff00) {die("Command exit with non-zero exit code"); }
    if ($ret) { die("Command failure $ret"); }
}

## WvTest handline

if (exists $variables->{WVDESC}) {
    print "Testing \"$variables->{WVDESC}\" in $last_fn:\n";
} elsif ($last_fn =~ /\.wv$/) {
    print "Testing \"all\" in $last_fn:\n";
}

## Connect to the target and check whether is not occupied

# We have to do this before file generation phase, because file
# generation is intermixed with file deployment phase and we want to
# check whether the target is not used by somebody else before
# deploying files. Otherwise, we may rewrite other user's files on a
# boot server.

my $exp; # Expect object to communicate with the target over serial line

my ($target_reset, $target_power_on, $target_power_off);

if (defined $iprelay) {
    my $IPRELAY;
    $iprelay =~ /([.0-9]+)(:([0-9]+))?/;
    my $addr = $1;
    my $port = $3 || 23;
    my $paddr   = sockaddr_in($port, inet_aton($addr));
    my $proto   = getprotobyname('tcp');
    socket($IPRELAY, PF_INET, SOCK_STREAM, $proto)  || die "socket: $!";
    print "novaboot: Connecting to IP relay... ";
    connect($IPRELAY, $paddr)    || die "connect: $!";
    print "done\n";
    $exp = Expect->init(\*$IPRELAY);
    $exp->log_stdout(1);

    while (1) {
        print $exp "\xFF\xF6";  # AYT
        my $connected = $exp->expect(20, # Timeout in seconds
                                     '<iprelayd: connected>',
                                     '-re', '<WEB51 HW[^>]*>');
        last if $connected;
    }

    sub relaycmd($$) {
        my ($relay, $onoff) = @_;
        die unless ($relay == 1 || $relay == 2);

        my $cmd = ($relay == 1 ? 0x5 : 0x6) | ($onoff ? 0x20 : 0x10);
        return "\xFF\xFA\x2C\x32".chr($cmd)."\xFF\xF0";
    }

    sub relayconf($$) {
        my ($relay, $onoff) = @_;
        die unless ($relay == 1 || $relay == 2);
        my $cmd = ($relay == 1 ? 0xdf : 0xbf) | ($onoff ? 0x00 : 0xff);
        return "\xFF\xFA\x2C\x97".chr($cmd)."\xFF\xF0";
    }

    sub relay($$;$) {
        my ($relay, $onoff, $can_giveup) = @_;
        my $confirmation = '';
        $exp->log_stdout(0);
        print $exp relaycmd($relay, $onoff);
        my $confirmed = $exp->expect(20, # Timeout in seconds
                                     relayconf($relay, $onoff));
        if (!$confirmed) {
            if ($can_giveup) {
                print("Relay confirmation timeout - ignoring\n");
            } else {
                die "Relay confirmation timeout";
            }
        }
        $exp->log_stdout(1);
    }

    $target_reset = sub {
        relay(2, 1, 1); # Reset the machine
        usleep(100000);
        relay(2, 0);
    };

    $target_power_off = sub {
        relay(1, 1);            # Press power button
        usleep(6000000);        # Long press to switch off
        relay(1, 0);
    };

    $target_power_on = sub {
        relay(1, 1);            # Press power button
        usleep(100000);         # Short press
        relay(1, 0);
    };
}
elsif ($serial) {
    my $CONN;
    system_verbose("stty -F $serial $stty");
    open($CONN, "+<", $serial) || die "open $serial: $!";
    $exp = Expect->init(\*$CONN);
} else {
    $exp = new Expect(); # Make $exp ready for calling $exp->spawn() later

    if ($remote_cmd) {
        print "novaboot: Running: $remote_cmd\n";
        $exp->spawn($remote_cmd);
    }
}

if (defined $reset_cmd) {
    $target_reset = sub {
        system_verbose($reset_cmd);
    };
}

if (defined $on_opt && defined $target_power_on) {
    &$target_power_on();
    exit;
}
if (defined $off_opt && defined $target_power_off) {
    print "novaboot: Switching the target off...\n";
    &$target_power_off();
    exit;
}

$builddir ||= dirname(File::Spec->rel2abs( ${$scripts[0]}{filename})) if scalar @scripts;
if (defined $builddir) {
    chdir($builddir) or die "Can't change directory to $builddir: $!";
    print "novaboot: Entering directory `$builddir'\n";
}

## File generation phase
my (%files_iso, $menu_iso, $filename);
my $config_name = '';

foreach my $script (@scripts) {
    $filename = $$script{filename};
    $modules = $$script{modules};
    $generated = $$script{generated};
    $variables = $$script{variables};

    ($config_name = $filename) =~ s#.*/##;
    $config_name = $config_name_opt if (defined $config_name_opt);

    if (exists $variables->{BUILDDIR}) {
        $builddir = File::Spec->rel2abs($variables->{BUILDDIR});
        chdir($builddir) or die "Can't change directory to $builddir: $!";
        print "novaboot: Entering directory `$builddir'\n";
    }

    my $kernel;
    if (exists $variables->{KERNEL}) {
        $kernel = $variables->{KERNEL};
    } else {
        if ($CFG::hypervisor) {
            $kernel = $CFG::hypervisor . " ";
            if (exists $variables->{HYPERVISOR_PARAMS}) {
                $kernel .= $variables->{HYPERVISOR_PARAMS};
            } else {
                $kernel .= $CFG::hypervisor_params;
            }
        }
    }
    @$modules = ($kernel, @$modules) if $kernel;
    @$modules = (@chainloaders, @$modules);
    @$modules = ("bin/boot/bender", @$modules) if ($bender || defined $ENV{'NOVABOOT_BENDER'});

    my $prefix;
    ($prefix = $grub_prefix) =~ s/\$NAME/$config_name/ if defined $grub_prefix;
    $prefix ||= $builddir;
    # TODO: use $grub_prefix as first parameter if some switch is given
    generate_configs('', $generated, $filename);

### Generate bootloader configuration files
    my @bootloader_configs;
    push @bootloader_configs, generate_grub_config($grub_config, $config_name, $prefix, $modules, $grub_preamble) if (defined $grub_config);
    push @bootloader_configs, generate_grub2_config($grub2_config, $config_name, $prefix, $modules, $grub_preamble, $grub2_prolog) if (defined $grub2_config);
    push @bootloader_configs, generate_pulsar_config('config-'.($pulsar||'novaboot'), $modules) if (defined $pulsar);

### Run scons
    if (defined $scons) {
        my @files = map({ ($file) = m/([^ ]*)/; $file; } @$modules);
        # Filter-out generated files
        my @to_build = grep({ my $file = $_; !scalar(grep($file eq $$_{filename}, @$generated)) } @files);
        system_verbose($scons || $CFG::scons." ".join(" ", @to_build));
    }

### Copy files (using rsync)
    if (defined $server && !defined($gen_only)) {
        (my $real_server = $server) =~ s/\$NAME/$config_name/;

        my ($hostname, $path) = split(":", $real_server, 2);
        if (! defined $path) {
            $path = $hostname;
            $hostname = "";
        }
        my $files = join(" ", map({ ($file) = m/([^ ]*)/; $file; } ( @$modules, @bootloader_configs)));
        map({ my $file = (split)[0]; die "$file: $!" if ! -f $file; } @$modules);
        my $istty = -t STDOUT && ($ENV{'TERM'} || 'dumb') ne 'dumb';
        my $progress = $istty ? "--progress" : "";
        system_verbose("rsync $progress -RLp $rsync_flags $files $real_server");
        if ($server =~ m|/\$NAME$| && $concat) {
            my $cmd = join("; ", map { "( cd $path/.. && cat */$_ > $_ )" } @bootloader_configs);
            system_verbose($hostname ? "ssh $hostname '$cmd'" : $cmd);
        }
    }

### Prepare ISO image generation
    if (defined $iso_image) {
        generate_configs("(cd)", $generated, $filename);
        my $menu;
        generate_grub_config(\$menu, $config_name, "(cd)", $modules);
        $menu_iso .= "$menu\n";
        map { ($file,undef) = split; $files_iso{$file} = 1; } @$modules;
    }
}

## Generate ISO image
if (defined $iso_image) {
    open(my $fh, ">menu-iso.lst");
    print $fh "timeout 5\n\n$menu_iso";
    close($fh);
    my $files = "boot/grub/menu.lst=menu-iso.lst " . join(" ", map("$_=$_", keys(%files_iso)));
    $iso_image ||= "$config_name.iso";
    system_verbose("$CFG::genisoimage -R -b stage2_eltorito -no-emul-boot -boot-load-size 4 -boot-info-table -hide-rr-moved -J -joliet-long -o $iso_image -graft-points bin/boot/grub/ $files");
    print("ISO image created: $builddir/$iso_image\n");
}

exit(0) if defined $gen_only;

## Boot the system using various methods and send serial output to stdout

if (scalar(@scripts) > 1 && ( defined $dhcp_tftp || defined $serial || defined $iprelay)) {
    die "You cannot do this with multiple scripts simultaneously";
}

if ($variables->{WVTEST_TIMEOUT}) {
    print "wvtest: timeout ", $variables->{WVTEST_TIMEOUT}, "\n";
}

sub trim($) {
    my ($str) = @_;
    $str =~ s/^\s+|\s+$//g;
    return $str
}

### Qemu

if (!(defined $dhcp_tftp || defined $serial || defined $iprelay || defined $server || defined $iso_image)) {
    # Qemu
    $qemu ||= $variables->{QEMU} || $CFG::qemu;
    my @qemu_flags = split(" ", $qemu);
    $qemu = shift(@qemu_flags);

    @qemu_flags = split(/ +/, trim($variables->{QEMU_FLAGS})) if exists $variables->{QEMU_FLAGS};
    @qemu_flags = split(/ +/, trim($qemu_flags_cmd)) if $qemu_flags_cmd;
    push(@qemu_flags, split(/ +/, trim($qemu_append || '')));

    if (defined $iso_image) {
        # Boot NOVA with grub (and test the iso image)
        push(@qemu_flags, ('-cdrom', "$config_name.iso"));
    } else {
        # Boot NOVA without GRUB

        # Non-patched qemu doesn't like commas, but NUL can live with pluses instead of commans
        foreach (@$modules) {s/,/+/g;}
        generate_configs("", $generated, $filename);

        if (scalar @$modules) {
            my ($kbin, $kcmd) = split(' ', shift(@$modules), 2);
            $kcmd = '' if !defined $kcmd;
            my $dtb;
            @$modules = map { if (/\.dtb$/) { $dtb=$_; (); } else { $_ } } @$modules;
            my $initrd = join ",", @$modules;

            push(@qemu_flags, ('-kernel', $kbin, '-append', $kcmd));
            push(@qemu_flags, ('-initrd', $initrd)) if $initrd;
            push(@qemu_flags, ('-dtb', $dtb)) if $dtb;
        }
    }
    push(@qemu_flags,  qw(-serial stdio)); # Redirect serial output (for collecting test restuls)
    unshift(@qemu_flags, ('-name', $config_name));
    print "novaboot: Running: ".shell_cmd_string($qemu, @qemu_flags)."\n";
    $exp->spawn(($qemu, @qemu_flags)) || die("exec() failed: $!");
}

### Local DHCPD and TFTPD

my ($dhcpd_pid, $tftpd_pid);

if (defined $dhcp_tftp)
{
    generate_configs("(nd)", $generated, $filename);
    system_verbose('mkdir -p tftpboot');
    generate_grub_config("tftpboot/os-menu.lst", $config_name, "(nd)", \@$modules, "timeout 0");
    open(my $fh, '>', 'dhcpd.conf');
    my $mac = `cat /sys/class/net/eth0/address`;
    chomp $mac;
    print $fh "subnet 10.23.23.0 netmask 255.255.255.0 {
                      range 10.23.23.10 10.23.23.100;
                      filename \"bin/boot/grub/pxegrub.pxe\";
                      next-server 10.23.23.1;
}
host server {
        hardware ethernet $mac;
        fixed-address 10.23.23.1;
}";
    close($fh);
    system_verbose("sudo ip a add 10.23.23.1/24 dev eth0;
            sudo ip l set dev eth0 up;
            sudo touch dhcpd.leases");

    # We run servers by forking ourselves, because the servers end up
    # in our process group and get killed by signals sent to the
    # process group (e.g. Ctrl-C on terminal).
    $dhcpd_pid = fork();
    exec_verbose("sudo dhcpd -d -cf dhcpd.conf -lf dhcpd.leases -pf dhcpd.pid") if ($dhcpd_pid == 0);
    $tftpd_pid = fork();
    exec_verbose("sudo in.tftpd --foreground --secure -v -v -v --pidfile tftpd.pid $builddir") if ($tftpd_pid == 0);

    # Kill server when we die
    $SIG{__DIE__} = sub { system_verbose('sudo pkill --pidfile=dhcpd.pid');
                          system_verbose('sudo pkill --pidfile=tftpd.pid'); };
}

### Serial line or IP relay

if (defined $target_reset) {
    print "novaboot: Reseting the test box... ";
    &$target_reset();
    print "done\n";
}

if (defined $uboot) {
    print "novaboot: Waiting for uBoot prompt...\n";
    $exp->log_stdout(1);
    $exp->expect(20,
                 [qr/Hit any key to stop autoboot:/, sub { $exp->send('.'); exp_continue; }],
                 '=> ') || die "No uBoot prompt deteceted";

    $exp->send("dhcp\n");
    $exp->expect(1, '=> ');

    my ($kbin, $kcmd) = split(' ', shift(@$modules), 2);
    my $dtb;
    @$modules = map { if (/\.dtb$/) { $dtb=$_; (); } else { $_ } } @$modules;
    my $initrd = shift @$modules;

    my $kern_addr = '800000';
    my $initrd_addr = '-';
    my $dtb_addr = '';

    sleep(1);
    $exp->send("tftp $kern_addr $kbin\n");
    $exp->expect(1,
                 [qr/#/, sub { exp_continue; }],
                 '=> ') || die "Kernel load failed";
    if (defined $dtb) {
        $dtb_addr = '7f0000';
        $exp->send("tftp $dtb_addr $dtb\n");
        $exp->expect(1,
                     [qr/#/, sub { exp_continue; }],
                     '=> ') || die "Device tree load failed";
    }
    if (defined $initrd) {
        $initrd_addr = 'b00000';
        $exp->send("tftp $initrd_addr $initrd\n");
        $exp->expect(1,
                     [qr/#/, sub { exp_continue; }],
                     '=> ') || die "Initrd load failed";
    }
    $exp->send("mw f0000b00 \${psc_cfg}\n");
    $exp->send("set bootargs $kcmd\n");
    $exp->expect(1, '=> ');
    $exp->send("bootm $kern_addr $initrd_addr $dtb_addr\n");
}

if (defined $exp) {
    # Serial line of the target is available
    print "novaboot: Serial line interaction (press Ctrl-C to interrupt)...\n";
    $exp->log_stdout(1);
    my @inputs = ($exp);
    if (-t STDIN) { # Set up bi-directional communication if we run on terminal
        my $infile = new IO::File;
        $infile->IO::File::fdopen(*STDIN,'r');
        my $in_object = Expect->exp_init($infile);
        $in_object->set_group($exp);
        #$in_object->set_seq("\cC",undef);

        # I'm not sure when to use raw mode and when not. With
        # --dhcp-tftp, I want the output of daemons to be normally
        # formated (no raw mode). On the other hand, I don't want
        # input for qemu to be echoed. Need to think more about this.
        $in_object->manual_stty(1);
        push(@inputs, $in_object);
    }
    Expect::interconnect(@inputs);
}

## Kill dhcpc or tftpd
if (defined $dhcp_tftp) {
    die("novaboot: This should kill servers on background\n");
}

## Documentation

=head1 NAME

novaboot - A tool for booting various operating systems on various hardware or in qemu

=head1 SYNOPSIS

B<novaboot> [ options ] [--] script...

B<./script> [ options ]

B<novaboot> --help

=head1 DESCRIPTION

This program makes it easier to boot NOVA or other operating system
(OS) in different environments. It reads a so called novaboot script
and uses it either to boot the OS in an emulator (e.g. in qemu) or to
generate the configuration for a specific bootloader and optionally to
copy the necessary binaries and other needed files to proper
locations, perhaps on a remote server. In case the system is actually
booted, its serial output is redirected to standard output if that is
possible.

A typical way of using novaboot is to make the novaboot script
executable and set its first line to I<#!/usr/bin/env novaboot>. Then,
booting a particular OS configuration becomes the same as executing a
local program - the novaboot script.

With C<novaboot> you can:

=over 3

=item 1.

Run an OS in Qemu. This is the default action when no other action is
specified by command line switches. Thus running C<novaboot ./script>
(or C<./script> as described above) will run Qemu and make it boot the
configuration specified in the I<script>.

=item 2.

Create a bootloader configuration file (currently supported
bootloaders are GRUB, GRUB2, Pulsar and uBoot) and copy it with all
other files needed for booting to another, perhaps remote, location.

 ./script --server --iprelay=192.168.1.2

This command copies files to a TFTP server specified in the
configuration file and uses TCP/IP-controlled relay to reset the test
box and receive its serial output.

=item 3.

Run DHCP and TFTP server on developer's machine to PXE-boot NOVA from
it. E.g.

 ./script --dhcp-tftp

When a PXE-bootable machine is connected via Ethernet to developer's
machine, it will boot the configuration described in I<script>.

=item 4.

Create bootable ISO images. E.g.

 novaboot --iso -- script1 script2

The created ISO image will have GRUB bootloader installed on it and
the boot menu will allow selecting between I<script1> and I<script2>
configurations.

=back

=head1 PHASES AND OPTIONS

Novaboot performs its work in several phases. Each phase can be
influenced by several options, certain phases can be skipped. The list
of phases (in the execution order) and the corresponding options
follows.

=head2 Configuration reading phase

After starting, novaboot reads configuration files. By default, it
searches for files named F<.novaboot> starting from the directory of
the novaboot script (or working directory, see bellow) and continuing
upwards up to the root directory. The configuration files are read in
order from the root directory downwards with latter files overriding
settings from the former ones.

In certain cases, the location of the novaboot script cannot be
determined in this early phase. This happens either when the script is
read from the standard input or when novaboot is invoked explicitly
and options precede the script name, as in the example L</"4."> above.
In this case the current working directory is used as a starting point
for configuration file search.

=over 8

=item -c, --config=<filename>

Use the specified configuration file instead of the default one(s).

=back

=head2 Command line processing phase

=over 8

=item --dump-config

Dump the current configuration to stdout end exits. Useful as an
initial template for a configuration file.

=item -h, --help

Print short (B<-h>) or long (B<--help>) help.

=item -t, --target=<target>

This option serves as a user configurable shortcut for other novaboot
options. The effect of this option is the same as the options stored
in the C<%targets> configuration variable under key I<target>. See
also L</"CONFIGURATION FILE">.

=back

=head2 Script preprocessing phase

This phases allows to modify the parsed novaboot script before it is
used in the later phases.

=over 8

=item -a, --append=<parameters>

Appends a string to the first "filename" line in the novaboot script.
This can be used to append parameters to the kernel's or root task's
command line.

=item -b, --bender

Use F<bender> chainloader. Bender scans the PCI bus for PCI serial
ports and stores the information about them in the BIOS data area for
use by the kernel.

=item --chainloader=<chainloader>

Chainloader that is loaded before the kernel and other files specified
in the novaboot script. E.g. 'bin/boot/bender promisc'.

=item --dump

Prints the content of the novaboot script after removing comments and
evaluating all I<--scriptmod> expressions. Exit after reading (and
dumping) the script.

=item --scriptmod=I<perl expression>

When novaboot script is read, I<perl expression> is executed for every
line (in $_ variable). For example, C<novaboot
--scriptmod=s/sigma0/omega6/g> replaces every occurrence of I<sigma0>
in the script with I<omega6>.

When this option is present, it overrides I<$script_modifier> variable
from the configuration file, which has the same effect. If this option
is given multiple times all expressions are evaluated in the command
line order.

=item --strip-rom

Strip I<rom://> prefix from command lines and generated config files.
The I<rom://> prefix is used by NUL. For NRE, it has to be stripped.

=back

=head2 File generation phase

In this phase, files needed for booting are generated in a so called
I<build directory> (see TODO). In most cases configuration for a
bootloader is generated automatically by novaboot. It is also possible
to generate other files using I<heredoc> or I<"<"> syntax in novaboot
scripts. Finally, binaries can be generated in this phases by running
C<scons> or C<make>.

=over 8

=item --build-dir=<directory>

Overrides the default build directory location.

The default build directory location is determined as follows: If the
configuration file defines the C<$builddir> variable, its value is
used. Otherwise, it is the directory that contains the first processed
novaboot script.

=item -g, --grub[=I<filename>]

Generates grub bootloader menu file. If the I<filename> is not
specified, F<menu.lst> is used. The I<filename> is relative to the
build directory (see B<--build-dir>).

=item --grub-preamble=I<prefix>

Specifies the I<preable> that is at the beginning of the generated
GRUB or GRUB2 config files. This is useful for specifying GRUB's
timeout.

=item --grub-prefix=I<prefix>

Specifies I<prefix> that is put in front of every file name in GRUB's
F<menu.lst>. The default value is the absolute path to the build directory.

If the I<prefix> contains string $NAME, it will be replaced with the
name of the novaboot script (see also B<--name>).

=item --grub2[=I<filename>]

Generate GRUB2 menuentry in I<filename>. If I<filename> is not
specified F<grub.cfg> is used. The content of the menuentry can be
customized with B<--grub-preable>, B<--grub2-prolog> or
B<--grub_prefix> options.

In order to use the the generated menuentry on your development
machine that uses GRUB2, append the following snippet to
F</etc/grub.d/40_custom> file and regenerate your grub configuration,
i.e. run update-grub on Debian/Ubuntu.

  if [ -f /path/to/nul/build/grub.cfg ]; then
    source /path/to/nul/build/grub.cfg
  fi

=item --grub2-prolog=I<prolog>

Specifies text I<preable> that is put at the begiging of the entry
GRUB2 entry.

=item --name=I<string>

Use the name I<string> instead of the name of the novaboot script.
This name is used for things like a title of grub menu or for the
server directory where the boot files are copied to.

=item --no-file-gen

Do not generate files on the fly (i.e. "<" syntax) except for the
files generated via "<<WORD" syntax.

=item -p, --pulsar[=mac]

Generates pulsar bootloader configuration file named F<config-I<mac>>
The I<mac> string is typically a MAC address and defaults to
I<novaboot>.

=item --scons[=scons command]

Runs I<scons> to build files that are not generated by novaboot
itself.

=item --gen-only

Exit novaboot after file generation phase.

=back

=head2 Target connection check

If supported by the target, the connection to it is made and it is
checked whether the target is not occupied by another novaboot
user/instance.

=head2 File deployment phase

In some setups, it is necessary to copy the files needed for booting
to a particular location, e.g. to a TFTP boot server or to the
F</boot> partition.

=over 8

=item -d, --dhcp-tftp

Turns your workstation into a DHCP and TFTP server so that NOVA
can be booted via PXE BIOS on a test machine directly connected by
a plain Ethernet cable to your workstation.

The DHCP and TFTP servers require root privileges and C<novaboot>
uses C<sudo> command to obtain those. You can put the following to
I</etc/sudoers> to allow running the necessary commands without
asking for password.

 Cmnd_Alias NOVABOOT = /bin/ip a add 10.23.23.1/24 dev eth0, /bin/ip l set dev eth0 up, /usr/sbin/dhcpd -d -cf dhcpd.conf -lf dhcpd.leases -pf dhcpd.pid, /usr/sbin/in.tftpd --foreground --secure -v -v -v --pidfile tftpd.pid *, /usr/bin/touch dhcpd.leases, /usr/bin/pkill --pidfile=dhcpd.pid, /usr/bin/pkill --pidfile=tftpd.pid
 your_login ALL=NOPASSWD: NOVABOOT

=item -i, --iso[=filename]

Generates the ISO image that boots NOVA system via GRUB. If no filename
is given, the image is stored under I<NAME>.iso, where I<NAME> is the name
of the novaboot script (see also B<--name>).

=item --server[=[[user@]server:]path]

Copy all files needed for booting to another location (implies B<-g>
unless B<--grub2> is given). The files will be copied (by B<rsync>
tool) to the directory I<path>. If the I<path> contains string $NAME,
it will be replaced with the name of the novaboot script (see also
B<--name>).

=item --concat

If B<--server> is used and its value ends with $NAME, then after
copying the files, a new bootloader configuration file (e.g. menu.lst)
is created at I<path-wo-name>, i.e. the path specified by B<--server>
with $NAME part removed. The content of the file is created by
concatenating all files of the same name from all subdirectories of
I<path-wo-name> found on the "server".

=item --rsync-flags=I<flags>

Specifies which I<flags> are appended to F<rsync> command line when
copying files as a result of I<--server> option.

=back

=head2 Target power-on and reset phase

=over 8

=item --iprelay=I<addr[:port]>

Use IP relay to reset the machine and to get the serial output. The IP
address of the relay is given by I<addr> parameter.

Note: This option is expected to work with HWG-ER02a IP relays.

=item --on, --off

Switch on/off the target machine. Currently works only with
B<--iprelay>.

=item -Q, --qemu=I<qemu-binary>

The name of qemu binary to use. The default is 'qemu'.

=item --qemu-append=I<flags>

Append I<flags> to the default qemu flags (QEMU_FLAGS variable or
C<-cpu coreduo -smp 2>).

=item -q, --qemu-flags=I<flags>

Replace the default qemu flags (QEMU_FLAGS variable or C<-cpu coreduo
-smp 2>) with I<flags> specified here.

=back

=head2 Interaction with the bootloader on the target

See B<--serial>. There will be new options soon.

=over 8

=item --uboot

Interact with uBoot bootloader to boot the thing described in the
novaboot script. Implementation of this option is currently tied to a
particular board that we use. It may be subject to changes in the
future!

=back

=head2 Target's output reception phase

=over 8

=item -s, --serial[=device]

Use serial line to control GRUB bootloader and to see the output
serial output of the machine. The default value is F</dev/ttyUSB0>.

=item --stty=<settings>

Specifies settings passed to C<stty> invoked on the serial line
specified with B<--serial>. If this option is not given, C<stty> is
called with C<raw -crtscts -onlcr 115200> settings.

=item --remote-cmd=<cmd>

Command that mediates connection to the target's serial line. For
example C<ssh server 'cu -l /dev/ttyS0'>.

=item --reset-cmd=<cmd>

Command that resets the target.

=back

See also B<--iprelay>.

=head2 Termination phase

Daemons that were spwned (F<dhcpd> and F<tftpd>) are killed here.

=head1 NOVABOOT SCRIPT SYNTAX

The syntax tries to mimic POSIX shell syntax. The syntax is defined with the following rules.

Lines starting with "#" are ignored.

Lines that end with "\" are concatenated with the following line after
removal of the final "\" and leading whitespace of the following line.

Lines in the form I<VARIABLE=...> (i.e. matching '^[A-Z_]+=' regular
expression) assign values to internal variables. See VARIABLES
section.

Otherwise, the first word on the line represents the filename
(relative to the build directory (see B<--build-dir>) of the module to
load and the remaining words are passed as the command line
parameters.

When the line ends with "<<WORD" then the subsequent lines until the
line containing only WORD are copied literally to the file named on
that line.

When the line ends with "< CMD" the command CMD is executed with
C</bin/sh> and its standard output is stored in the file named on that
line. The SRCDIR variable in CMD's environment is set to the absolute
path of the directory containing the interpreted novaboot script.

Example:
  #!/usr/bin/env novaboot
  WVDESC=Example program
  bin/apps/sigma0.nul S0_DEFAULT script_start:1,1 \
    verbose hostkeyb:0,0x60,1,12,2
  bin/apps/hello.nul
  hello.nulconfig <<EOF
  sigma0::mem:16 name::/s0/log name::/s0/timer name::/s0/fs/rom ||
  rom://bin/apps/hello.nul
  EOF

This example will load three modules: sigma0.nul, hello.nul and
hello.nulconfig. sigma0 gets some command line parameters and
hello.nulconfig file is generated on the fly from the lines between
<<EOF and EOF.

=head2 VARIABLES

The following variables are interpreted in the novaboot script:

=over 8

=item BUILDDIR

Novaboot chdir()s to this directory before file generation phase. The
directory name specified here is relative to the build directory
specified by other means (see L</--build-dir>).

=item WVDESC

Description of the wvtest-compliant program.

=item WVTEST_TIMEOUT

The timeout in seconds for WvTest harness. If no complete line appears
in the test output within the time specified here, the test fails. It
is necessary to specify this for long running tests that produce no
intermediate output.

=item QEMU

Use a specific qemu binary (can be overriden with B<-Q>) and flags
when booting this script under qemu. If QEMU_FLAGS variable is also
specified flags specified in QEMU variable are replaced by those in
QEMU_FLAGS.

=item QEMU_FLAGS

Use specific qemu flags (can be overriden with B<-q>).

=item HYPERVISOR_PARAMS

Parameters passed to hypervisor. The default value is "serial", unless
overriden in configuration file.

=item KERNEL

The kernel to use instead of NOVA hypervisor specified in the
configuration file. The value should contain the name of the kernel
image as well as its command line parameters. If this variable is
defined and non-empty, the variable HYPERVISOR_PARAMS is not used.

=back

=head1 CONFIGURATION FILE

Novaboot can read its configuration from a file. Configuration file
was necessary in early days of novaboot. Nowadays, an attempt is made
to not use the configuration file because it makes certain novaboot
scripts unusable on systems without (or with different) configuration
file. The only recommended use of the configuration file is to specify
custom_options (see bellow).

If you decide to use the configuration file, it is looked up, by
default, in files named F<.novaboot> as described in L</Configuration
reading phase>. Alternatively, its location can be specified with the
B<-c> switch or with the NOVABOOT_CONFIG environment variable. The
configuration file has perl syntax and should set values of certain
Perl variables. The current configuration can be dumped with the
B<--dump-config> switch. Some configuration variables can be overriden
by environment variables (see below) or by command line switches.

Documentation of some configuration variables follows:

=over 8

=item $builddir

Build directory location relative to the location of the configuration
file.

=item %targets

Hash of shortcuts to be used with the B<--target> option. If the hash
contains, for instance, the following pair of values

 'mybox' => '--server=boot:/tftproot --serial=/dev/ttyUSB0 --grub',

then the following two commands are equivalent:

 ./script --server=boot:/tftproot --serial=/dev/ttyUSB0 --grub
 ./script -t mybox

=back

=head1 ENVIRONMENT VARIABLES

Some options can be specified not only via config file or command line
but also through environment variables. Environment variables override
the values from configuration file and command line parameters
override the environment variables.

=over 8

=item NOVABOOT_CONFIG

Name of the novaboot configuration file to use instead of the default
one(s).

=item NOVABOOT_BENDER

Defining this variable has the same meaning as B<--bender> option.

=back

=head1 AUTHORS

Michal Sojka <sojka@os.inf.tu-dresden.de>