failnix/scripts/runner.pl

#!/usr/bin/env perl

use strict;
use warnings;
use diagnostics;

use feature 'say';

my $remote_root       = '/home/lab/smchurla/Documents/failnix';
my $remote_db_conf    = "$remote_root/db.conf";
my $remote_builds_dir = "$remote_root/builds";
my $remote_runner     = "$remote_root/scripts/runner.pl";

my $db_user   = "smchurla";
my $db_prefix = "$db_user";

my $fail_server_port   = '22941';
my $resultbrowser_port = '22941';
my $fail_bin           = "$remote_root/fail/bin";
my $fail_share         = "$remote_root/fail/share";
my $bochs_runner       = "$fail_bin/bochs-experiment-runner.py";
my $fail_trace         = "$fail_bin/fail-x86-tracing";
my $fail_dump          = "$fail_bin/dump-trace";
my $fail_import        = "$fail_bin/import-trace";
my $fail_prune         = "$fail_bin/prune-trace";
my $fail_server        = "$fail_bin/generic-experiment-server";
my $fail_inject        = "$fail_bin/generic-experiment-client";
my $result_browser     = "$fail_bin/resultbrowser.py";

my $ntfy_url   = "https://ntfy.vps.chriphost.de";
my $ntfy_token = "tk_rx8fd6hojuz4ekcb72j7juugkbmga";    # May be public
my $ntfy_topic = "fail-alerts";

sub notify {
    my ($msg) = @_;

    system( "curl", "-H", "Authorization: Bearer $ntfy_token",
        "-d", $msg, "$ntfy_url/$ntfy_topic" );
}

sub update_db_config {
    my ($experiment) = @_;

    open( my $readhandle, '<', $remote_db_conf )
      or die "failed to open db.conf: $!";
    my @lines;
    my $found = 0;
    while ( my $line = <$readhandle> ) {
        if ( rindex( $line, "database=", 0 ) == 0 ) {
            $line  = "database=${db_prefix}_$experiment\n";
            $found = 1;
        }
        push @lines, $line;
    }
    close($readhandle) or die "failed to close db.conf: $!";

    die "no database= line found in $remote_db_conf for some reason"
      unless $found;

    open( my $writehandle, '>', $remote_db_conf )
      or die "failed to open db.conf: $!";
    print $writehandle @lines or die "failed to write db.conf: $!";
    close($writehandle)       or die "failed to close db.conf: $!";

    say "Updated db.conf for database $db_prefix\_$experiment";
}

sub cpu_count {
    open( my $handle, "/proc/cpuinfo" ) or die "Can't open cpuinfo: $!\n";
    my $count = scalar( map /^processor/, <$handle> );
    close $handle;

    return $count;
}

# Find new experiments
opendir( my $dhandle, $remote_builds_dir )
  or die "opendir($remote_builds_dir): $!";
my @experiments = grep { $_ ne '.' && $_ ne '..' && -d "$remote_builds_dir/$_" }
  readdir($dhandle);
closedir($dhandle);

sub trace {
    my ($experiment) = @_;

    notify("Tracing $experiment...");

    system(
        "$bochs_runner -V $fail_share/vgabios.bin -b $fail_share/BIOS-bochs-latest -1 -f $fail_trace -e $remote_builds_dir/$experiment/system.elf -i $remote_builds_dir/$experiment/system.iso -- -Wf,--start-symbol=fail_start_trace -Wf,--save-symbol=fail_start_trace -Wf,--end-symbol=fail_stop_trace -Wf,--state-file=$remote_builds_dir/$experiment/state -Wf,--trace-file=$remote_builds_dir/$experiment/trace.pb -Wf,--elf-file=$remote_builds_dir/$experiment/system.elf"
    );

    # notify("Tracing $experiment complete.");
}

sub import_trace {
    my ($experiment) = @_;

    notify("Importing $experiment trace...");

    system(
        "$fail_import --database-option-file $remote_db_conf -t $remote_builds_dir/$experiment/trace.pb -i MemoryImporter -e $remote_builds_dir/$experiment/system.elf -v $experiment -b mem"
    );
    system(
        "$fail_import --database-option-file $remote_db_conf -t $remote_builds_dir/$experiment/trace.pb -i RegisterImporter -e $remote_builds_dir/$experiment/system.elf -v $experiment -b regs --flags"
    );
    system(
        "$fail_import --database-option-file $remote_db_conf -t $remote_builds_dir/$experiment/trace.pb -i RegisterImporter -e $remote_builds_dir/$experiment/system.elf -v $experiment -b ip --no-gp --ip"
    );
    system(
        "$fail_import --database-option-file $remote_db_conf -t $remote_builds_dir/$experiment/trace.pb -i ElfImporter --objdump objdump -e $remote_builds_dir/$experiment/system.elf -v $experiment -b ip"
    );
    system(
        "$fail_import --database-option-file $remote_db_conf -t $remote_builds_dir/$experiment/trace.pb -i ElfImporter --objdump objdump -e $remote_builds_dir/$experiment/system.elf -v $experiment -b mem"
    );
    system(
        "$fail_import --database-option-file $remote_db_conf -t $remote_builds_dir/$experiment/trace.pb -i ElfImporter --objdump objdump -e $remote_builds_dir/$experiment/system.elf -v $experiment -b regs"
    );
    system( "$fail_prune --database-option-file $remote_db_conf -v $experiment -b %% --overwrite" );

    # notify("Importing $experiment trace complete.");
}

sub inject {
    my ($experiment) = @_;

    notify("Injecting $experiment...");

    my $pid = fork();
    die "fork failed: $!" unless defined $pid;

    if ( $pid == 0 ) {

        # child -> server
        exec(
            "$fail_server --port $fail_server_port --database-option-file $remote_db_conf -v $experiment -b % --inject-single-bit --inject-registers"
        ) or die "exec server failed: $!";
    }

    # parent -> client
    # my $count = cpu_count();
    my $count = 1;

        # "-Wf,--catch-write-textsegment",
    system(
        "nice $bochs_runner -V $fail_share/vgabios.bin -b $fail_share/BIOS-bochs-latest -f $fail_inject -e $remote_builds_dir/$experiment/system.elf -i $remote_builds_dir/$experiment/system.iso -j $count -- -Wf,--server-port=$fail_server_port -Wf,--state-dir=$remote_builds_dir/$experiment/state -Wf,--trap -Wf,--catch-outerspace -Wf,--timeout=500000 -Wf,--ok-marker=fail_marker_positive -Wf,--fail-marker=fail_marker_negative -Wf,--detected-marker=fail_marker_detected > /dev/null"
    ) or die "client failed: $?";

    kill 'TERM', $pid;
    waitpid( $pid, 0 );

    # notify("Injecting $experiment complete.");
}

# TODO: Add a function that accepts query + output file args
sub results {
    my ($experiment) = @_;

    notify("Querying $experiment...");

    my $results_overview_query = "SELECT
variant, benchmark, resulttype, sum(t.time2 - t.time1 + 1) as faults
FROM variant v
JOIN trace t ON v.id = t.variant_id
JOIN fspgroup g ON g.variant_id = t.variant_id AND g.instr2 = t.instr2 AND g.data_address = t.data_address
JOIN result_GenericExperimentMessage r ON r.pilot_id = g.pilot_id
JOIN fsppilot p ON r.pilot_id = p.id
WHERE v.variant = '$experiment'
GROUP BY v.id, resulttype
ORDER BY variant, benchmark, resulttype;";

    my $results_overview = qx{
        mariadb --defaults-file=$remote_db_conf -t -e "$results_overview_query"
    };
    die "Query failed: $?" if $? != 0;

    open( my $results_overview_handle,
        '>', "$remote_builds_dir/$experiment/results.txt" )
      or die "failed to open file: $!";
    print $results_overview_handle $results_overview;
    close($results_overview_handle) or die "failed to close file: $!";

    my $fail_markers_query = "SELECT
CONCAT('0x', HEX(p.injection_instr_absolute)) AS fault_address,
SUM(t.time2 - t.time1 + 1) AS total_fail_markers
FROM trace t
JOIN variant v ON v.id = t.variant_id
JOIN fspgroup g ON g.variant_id = t.variant_id AND g.instr2 = t.instr2 AND g.data_address = t.data_address
JOIN result_GenericExperimentMessage r ON r.pilot_id = g.pilot_id
JOIN fsppilot p ON p.id = r.pilot_id
WHERE v.variant = '$experiment' AND r.resulttype = 'FAIL_MARKER'
GROUP BY p.injection_instr_absolute
ORDER BY SUM(t.time2 - t.time1 + 1) DESC;";

    my $fail_markers = qx{
        mariadb --defaults-file=$remote_db_conf --batch --raw -e "$fail_markers_query"
    };
    die "Query failed: $?" if $? != 0;
    $fail_markers =~ s/\t/,/g;

    open( my $fail_markers_handle,
        '>', "$remote_builds_dir/$experiment/markers.csv" )
      or die "failed to open file: $!";
    print $fail_markers_handle $fail_markers;
    close($fail_markers_handle) or die "failed to close file: $!";
}

# Run experiments
for my $experiment (@experiments) {
    update_db_config($experiment);

    trace($experiment);
    import_trace($experiment);
    inject($experiment);
    results($experiment);
}