Allow specifying empty target

[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 = $ENV{PWD} || getcwd();

## Configuration file handling

# Default configuration
$CFG::hypervisor = "";
$CFG::hypervisor_params = "serial";
$CFG::genisoimage = "genisoimage";
$CFG::qemu = 'qemu -cpu coreduo -smp 2';
$CFG::default_target = 'qemu';
%CFG::targets = (
    'qemu' => '--qemu',
    "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)\'"',
    "ryuglab" => '--server=pc-sojkam.felk.cvut.cz:/srv/tftp --uboot --uboot-init="mw f0000b00 \${psc_cfg}; sleep 1" --remote-cmd="ssh -t pc-sojkam.felk.cvut.cz \"cu -l /dev/ttyUSB0 -s 115200\"" --remote-expect="Connected." --reset-cmd="ssh -t pc-sojkam.felk.cvut.cz \"dtrrts /dev/ttyUSB0 1 1\""',
    "ryulocal" => '--dhcp-tftp --serial --uboot --uboot-init="dhcp; mw f0000b00 \${psc_cfg}; sleep 1" --reset-cmd="if which dtrrts; then dtrrts $NB_SERIAL 0 1; sleep 0.1; dtrrts $NB_SERIAL 1 1; fi"',

    );
chomp(my $nproc = `nproc`);
$CFG::scons = "scons -j$nproc";
$CFG::make = "make -j$nproc";

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 || -l $dir ) && $dir ne "/") {
        push @cfgs, "$dir/.novaboot" if -r "$dir/.novaboot";
        my @dirs = File::Spec->splitdir($dir);
        $dir = File::Spec->catdir(@dirs[0..$#dirs-1]);
    }
}
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 $explicit_target;
GetOptions ("target|t=s" => \$explicit_target);

my ($append, $bender, @chainloaders, $concat, $config_name_opt, $dhcp_tftp, $dump_opt, $dump_config, @exiton, $gen_only, $grub_config, $grub_prefix, $grub_preamble, $grub2_prolog, $grub2_config, $help, $iprelay, $iso_image, $interactive, $make, $man, $no_file_gen, $off_opt, $on_opt, $pulsar, $pulsar_root, $qemu, $qemu_append, $qemu_flags_cmd, $remote_cmd, $remote_expect, $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,
    "exiton=s"       => \@exiton,
    "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:s"          => \$iso_image,
    "interactive|i"  => \$interactive,
    "name=s"         => \$config_name_opt,
    "make|m:s"       => \$make,
    "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,
    "remote-expect=s"=> \$remote_expect,
    "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,
    "uboot"          => \$uboot,
    "uboot-init=s"   => \$uboot_init,
    "h"              => \$help,
    "help"           => \$man,
    );

# First process target options
{
    my $t = defined($explicit_target) ? $explicit_target : $CFG::default_target;
    if ($t) {
        exists $CFG::targets{$t} or die("Unknown target '$t' (valid targets are: ".join(", ", sort keys(%CFG::targets)).")");
        GetOptionsFromString($CFG::targets{$t}, %opt_spec);
    }
}

# Then process other command line options - some of them may override
# what was specified by the target
GetOptions %opt_spec or die("Error in command line arguments");
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 ($interactive && !-t STDIN) {
    die("novaboot: Interactive mode not supported when not on terminal");
}

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

# Default options
if (defined $serial) {
    $serial ||= "/dev/ttyUSB0";
    $ENV{NB_SERIAL} = $serial;
}
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;
        push(@exiton, $2) if ($1 eq "EXITON");
        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);
} elsif ($remote_cmd) {
    print "novaboot: Running: $remote_cmd\n";
    $exp = Expect->spawn($remote_cmd);
}

if ($remote_expect) {
    $exp->expect(10, $remote_expect) || die "Expect for '$remote_expect' timed out";
}

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 or make
    {
        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)) if (defined $scons);
        system_verbose($make  || $CFG::make ." ".join(" ", @to_build)) if (defined $make);
    }

### 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 $qemu) {
    # 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 = Expect->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->exp_internal(1);
    $exp->expect(20,
                 [qr/Hit any key to stop autoboot:/, sub { $exp->send("\n"); exp_continue; }],
                 '=> ') || die "No uBoot prompt deteceted";
    $exp->send("$uboot_init\n") if $uboot_init;
    $exp->expect(10, '=> ') || die "uBoot prompt timeout";

    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 = '';

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

if (defined $exp) {
    # Serial line of the target is available
    my $interrupt = 'Ctrl-C';
    if ($interactive && !@exiton) {
        $interrupt = '"~~."';
    }
    print "novaboot: Serial line interaction (press $interrupt to interrupt)...\n";
    $exp->log_stdout(1);
    if (@exiton) {
        $exp->expect(undef, @exiton);
    } else {
        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);

            if ($interactive) {
                $in_object->set_seq('~~\.', sub { print "novaboot: Escape sequence detected\r\n"; undef; });
                $in_object->manual_stty(0);       # Use raw terminal mode
            } else {
                $in_object->manual_stty(1);       # Do not modify terminal settings
            }
            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 ]

=head1 DESCRIPTION

This program makes it easier to boot NOVA or other operating system
(OS) on different targets (machines or emulators). It reads a so
called novaboot script, that specifies the boot configuration, and
setups the target to boot that configuration. Setting up the target
means to generate the bootloader configuration files, deploy the
binaries and other needed files to proper locations, perhaps on a
remote boot server and reset the target. Then, target's 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.

For example, 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=192.168.1.1:/tftp --iprelay=192.168.1.2

This command copies files to the TFTP server 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 the OS
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

Note that the options needed for a specific target can be stored in a
L</"CONFIGURATION FILE"> and then it is sufficient to use only the
B<-t> option to specify the name of the target.

=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
follow.

=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=I<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=I<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=I<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=I<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=I<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 beginning of the entry
GRUB2 entry.

=item -m, --make[=make command]

Runs C<make> to build files that are not generated by novaboot itself.

=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 C<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.

=over 8

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

Use TCP/IP relay and serial port to access the target's serial port
and powercycle it. The IP address of the relay is given by I<addr>
parameter. If I<port> is not specified, it default to 23.

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

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

Target's serial line is connected to host's serial line (device). The
default value for device is F</dev/ttyUSB0>.

The value of this option is exported in NB_NOVABOOT environment
variable to all subprocesses run by C<novaboot>.

=item --stty=I<settings>

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

=item --remote-cmd=I<cmd>

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

=item --remote-expect=I<string>

Wait for reception of I<string> on the remote connection before
continuing.

=back

=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 the OS can
be booted via PXE BIOS (or similar mechanism) on the 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 --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 --on, --off

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

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

Boot the configuration in qemu. Optionally, the name of qemu binary
can be specified as a parameter.

=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.

=item --reset-cmd=I<cmd>

Command that resets the target.

=back

=head2 Interaction with the bootloader on the target

=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!

=item --uboot-init

Command(s) to send the uBoot bootloader before loading the images and
botting them.

=back

=head2 Target interaction phase

In this phase, target's serial output is passed to C<novaboot> stdout.
If C<novaboot>'s stdin is on TTY, the stdin is passed to the target
allowing interactive work with the target.

This phase end when the target hangs up or when Ctrl-C is pressed.

=over 8

=item --exiton=I<string>

When I<string> is sent by the target, novaboot exits. This option can
be specified multiple times.

If I<string> is C<-re>, then the next B<--exiton>'s I<string> is
treated as regular expression. For example:

    --exiton -re --exiton 'error:.*failed'

=item -i, --interactive

Setup things for interactive use of target. Your terminal will be
switched to raw mode. In raw mode, your system does not process input
in any way (no echoing of entered characters, no interpretation
special characters). This, among others, means that Ctrl-C is passed
to the target and does no longer interrupt novaboot. Use "~~."
sequence to exit novaboot.

=back

=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 EXITON

Assigning this variable has the same effect as specifying L</--exiton>
option.

=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.

=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 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.

=back

=head1 CONFIGURATION FILE

Novaboot can read its configuration from one or more files. By
default, novaboot looks for 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.

Supported configuration variables include:

=over 8

=item $builddir

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

=item $default_target

Default target (see below) to use when no target is explicitly
specified on command line with the B<--target> option.

=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>