add curses entry point for scripts (archival, ghidra import, plots, queries, cleanup)

flake.nix

@@ -102,6 +102,8 @@ rec {
           # Determine the project root, used e.g. in cmake scripts
           set -g -x FLAKE_PROJECT_ROOT (git rev-parse --show-toplevel)
 
+          abbr -a fail "perl ./scripts/menu.pl"
+
           # C/C++:
           # abbr -a cmake-debug "${cmakeDebug}"
           # abbr -a cmake-release "${cmakeRelease}"

scripts/Mars.pm

@@ -0,0 +1,180 @@
+package Mars;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use DBI;
+use Net::OpenSSH;
+
+use feature 'say';
+
+my $local_root = '/home/christoph/Notes/TU/MastersThesis/FailNix';
+
+my $_remote     = undef;
+my $remote_host = 'mars';    # smchurla@mars.cs.tu-dortmund.de
+
+# The mars db is bound to local port 3306 over SSH.
+# - This requires using the configured 'mars'
+#   remote_host instead of smchurla@mars
+#   or setting up another tunnel here
+my $_db          = undef;
+my $db_host      = "127.0.0.1";
+my $db_port      = "3306";
+my $db_user      = "smchurla";
+my $_db_password = undef;
+
+sub ssh_connect {
+    if ( !defined $_remote ) {
+
+        # Initialize SSH connection
+        # - This connection also sets up the database tunnel
+        $_remote = Net::OpenSSH->new(
+            $remote_host,
+            timeout     => 30,
+            master_opts => [
+                -o => 'BatchMode=yes',
+                -o => 'StrictHostKeyChecking=accept-new',
+            ],
+        );
+        $_remote->error and die 'SSH connection failed: ' . $_remote->error;
+        say 'Connected to mars.cs.tu-dortmund.de';
+    }
+
+    return $_remote;
+}
+
+sub ssh_system {
+    my (@cmd) = @_;
+
+    my $ssh = ssh_connect();
+
+    $ssh->system(@cmd);
+    $ssh->error and die "Remote command failed (@cmd): " . $ssh->error;
+}
+
+sub ssh_capture {
+    my (@cmd) = @_;
+
+    my $ssh = ssh_connect();
+
+    my $out = $ssh->capture(@cmd);
+    $ssh->error and die "Remote command failed (@cmd): " . $ssh->error;
+
+    return $out;
+}
+
+sub upload_dir {
+    my ( $source_dir, $target_dir ) = @_;
+
+    my $ssh = ssh_connect();
+
+    say " - Uploading $source_dir to $target_dir...";
+    $ssh->scp_put(
+        {
+            recursive  => 1,
+            copy_attrs => 1
+        },
+        $source_dir,
+        $target_dir,
+    ) or die "Failed to upload $source_dir: " . $ssh->error;
+}
+
+sub download_dir {
+    my ( $source_dir, $target_dir ) = @_;
+
+    my $ssh = ssh_connect();
+
+    say " - Downloading $source_dir to $target_dir...";
+    $ssh->scp_get(
+        {
+            recursive  => 1,
+            copy_attrs => 1
+        },
+        $source_dir,
+        $target_dir,
+    ) or die "Failed to download $source_dir: " . $ssh->error;
+}
+
+sub find_remote_subdirs {
+    my ($dir) = @_;
+
+    my $out = ssh_capture(
+        'find',      $dir, '-mindepth', '1',
+        '-maxdepth', '1',  '-type',     'd',
+        '-printf',   '%f' . "\n",
+    );
+
+    my @subdirs = sort grep { length } split /\n/, $out;
+
+    return @subdirs;
+}
+
+sub read_db_password_file {
+    if ( !defined $_db_password ) {
+        open( my $fhandle, '<', "$local_root/mars-db.conf" )
+          or die "Failed to read mars-db.conf: $!";
+        chomp( $_db_password = <$fhandle> );
+        close($fhandle);
+    }
+
+    return $_db_password;
+}
+
+sub db_connect {
+
+    # Opens tunnel for db_port
+    my $ssh = ssh_connect();
+
+    if ( !defined $_db ) {
+        $_db = DBI->connect( "DBI:MariaDB:host=$db_host;port=$db_port",
+            $db_user, read_db_password_file() )
+          or die 'Failed to connect to database: ' . $DBI::errstr;
+        say 'Connected to database';
+    }
+
+    return $_db;
+}
+
+sub db_disconnect {
+    if ( defined $_db ) {
+        $_db->disconnect or warn $_db->errstr;
+    }
+}
+
+sub db_prefix {
+    return $db_user;
+}
+
+sub db_list {
+    my $db = db_connect();
+
+    my @db_names =
+      sort
+      map { s/DBI:MariaDB://r }
+      grep { !/information_schema|smchurla_ll/ } $db->data_sources();
+
+    return @db_names;
+}
+
+sub db_do {
+    my (@cmd) = @_;
+
+    my $db = db_connect();
+
+    $db->do(@cmd) or die "Database command failed (@cmd): " . $db->errstr;
+}
+
+sub db_create {
+    my ($db_name) = @_;
+    say " - Creating database $db_name...";
+    db_do("create database `$db_name`");
+}
+
+sub db_drop {
+    my ($db_name) = @_;
+    say " - Dropping database $db_name...";
+    db_do("drop database `$db_name`");
+}
+
+1;

scripts/Queries/Faults.pm

@@ -0,0 +1,29 @@
+package Queries::Faults;
+
+use strict;
+use warnings;
+use diagnostics;
+
+sub query {
+    my ($experiment) = @_;
+
+    return "SELECT
+benchmark, resulttype, SUM(t.time2 - t.time1 + 1) AS faults,
+CONCAT('0x', HEX(p.injection_instr_absolute)) AS fault_address
+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 benchmark, resulttype, p.injection_instr_absolute
+ORDER BY benchmark, resulttype, SUM(t.time2 - t.time1 + 1) DESC;"
+}
+
+sub args { return "--batch --raw"; }
+
+sub filename { return "faults.csv"; }
+
+sub postprocess { $_[0] =~ s/\t/,/g; }
+
+1;

scripts/Queries/FaultsFailed.pm

@@ -1,30 +0,0 @@
-package Queries::FaultsFailed;
-
-use strict;
-use warnings;
-use diagnostics;
-
-sub query {
-    my ($experiment) = @_;
-
-    my $resulttype = 'FAIL_MARKER';
-
-    return
-"SELECT CONCAT('0x', HEX(p.injection_instr_absolute)) AS fault_address, SUM(t.time2 - t.time1 + 1) AS total_results
-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 = '$resulttype'
-GROUP BY p.injection_instr_absolute
-ORDER BY SUM(t.time2 - t.time1 + 1) DESC;"
-}
-
-sub args { return "--batch --raw"; }
-
-sub filename { return "faults_failed.csv"; }
-
-sub postprocess { $_[0] =~ s/\t/,/g; }
-
-1;

scripts/Queries/FaultsOuterspace.pm

@@ -1,30 +0,0 @@
-package Queries::FaultsOuterspace;
-
-use strict;
-use warnings;
-use diagnostics;
-
-sub query {
-    my ($experiment) = @_;
-
-    my $resulttype = 'ACCESS_OUTERSPACE';
-
-    return
-"SELECT CONCAT('0x', HEX(p.injection_instr_absolute)) AS fault_address, SUM(t.time2 - t.time1 + 1) AS total_results
-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 = '$resulttype'
-GROUP BY p.injection_instr_absolute
-ORDER BY SUM(t.time2 - t.time1 + 1) DESC;"
-}
-
-sub args { return "--batch --raw"; }
-
-sub filename { return "faults_outerspace.csv"; }
-
-sub postprocess { $_[0] =~ s/\t/,/g; }
-
-1;

scripts/Queries/FaultsTimeout.pm

@@ -1,30 +0,0 @@
-package Queries::FaultsTimeout;
-
-use strict;
-use warnings;
-use diagnostics;
-
-sub query {
-    my ($experiment) = @_;
-
-    my $resulttype = 'TIMEOUT';
-
-    return
-"SELECT CONCAT('0x', HEX(p.injection_instr_absolute)) AS fault_address, SUM(t.time2 - t.time1 + 1) AS total_results
-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 = '$resulttype'
-GROUP BY p.injection_instr_absolute
-ORDER BY SUM(t.time2 - t.time1 + 1) DESC;"
-}
-
-sub args { return "--batch --raw"; }
-
-sub filename { return "faults_timeout.csv"; }
-
-sub postprocess { $_[0] =~ s/\t/,/g; }
-
-1;

scripts/Queries/FaultsTrap.pm

@@ -1,30 +0,0 @@
-package Queries::FaultsTrap;
-
-use strict;
-use warnings;
-use diagnostics;
-
-sub query {
-    my ($experiment) = @_;
-
-    my $resulttype = 'TRAP';
-
-    return
-"SELECT CONCAT('0x', HEX(p.injection_instr_absolute)) AS fault_address, SUM(t.time2 - t.time1 + 1) AS total_results
-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 = '$resulttype'
-GROUP BY p.injection_instr_absolute
-ORDER BY SUM(t.time2 - t.time1 + 1) DESC;"
-}
-
-sub args { return "--batch --raw"; }
-
-sub filename { return "faults_trap.csv"; }
-
-sub postprocess { $_[0] =~ s/\t/,/g; }
-
-1;

scripts/Queries/Results.pm

@@ -7,8 +7,8 @@ use diagnostics;
 sub query {
     my ($experiment) = @_;
 
-    return
+    return "SELECT
-"SELECT variant, benchmark, resulttype, sum(t.time2 - t.time1 + 1) AS faults
+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

scripts/Queries/ResultsData.pm

@@ -0,0 +1,28 @@
+package Queries::ResultsData;
+
+use strict;
+use warnings;
+use diagnostics;
+
+sub query {
+    my ($experiment) = @_;
+
+    return "SELECT
+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;";
+}
+
+sub args { return "--batch --raw"; }
+
+sub filename { return "resultsdata.csv"; }
+
+sub postprocess { $_[0] =~ s/\t/,/g; }
+
+1;

scripts/TUI.pm

@@ -0,0 +1,92 @@
+package TUI;
+
+use strict;
+use warnings;
+use diagnostics;
+
+use Curses::UI;
+
+# Singleton
+my $_cui;
+
+sub init_cui {
+    if ( !defined $_cui ) {
+        $_cui = new Curses::UI(
+            -color_support => 1,
+
+            # -clear_on_exit => 1,
+        );
+    }
+
+    return $_cui;
+}
+
+sub select_from_list {
+    my ( $title, $multiselect, @items ) = @_;
+    die "No items to choose from" unless @items;
+
+    my @values = $multiselect ? ( '__ALL__', @items ) : @items;
+    my %labels =
+      $multiselect
+      ? ( '__ALL__' => '[ALL]', map { $_ => $_ } @items, )
+      : map { $_ => $_ } @items;
+
+    my @selection;
+
+    my $cui = init_cui();
+
+    my $win = $cui->add( 'root', 'Window', );
+
+    my $listbox = $win->add(
+        'item_list',
+        'Listbox',
+        -title     => $title,
+        -border    => 1,
+        -values    => \@values,
+        -labels    => \%labels,
+        -multi     => $multiselect == 1,
+        -radio     => $multiselect == 0,
+        -padbottom => 1,
+
+    );
+
+    $win->add(
+        'info', 'Label',
+        -y    => -1,
+        -text => "Space/Enter = toggle, c = confirm, q = quit",
+    );
+
+    $listbox->clear_binding('loose-focus');
+
+    $listbox->set_binding(
+        sub {
+            my @picked = $listbox->get;
+            if ( $multiselect && grep { $_ eq '__ALL__' } @picked ) {
+                @selection = @items;
+            }
+            else {
+                @selection = @picked;
+            }
+            $cui->mainloopExit;
+        },
+        'c',
+    );
+
+    $listbox->set_binding(
+        sub {
+            @selection = ();
+            $cui->mainloopExit;
+        },
+        'q',
+    );
+
+    $listbox->focus;
+    $cui->mainloop;
+
+    $cui->leave_curses;
+    $cui->delete('root');
+
+    return @selection;
+}
+
+1;

scripts/Util.pm

@@ -4,6 +4,8 @@ use strict;
 use warnings;
 use diagnostics;
 
+use DateTime;
+
 use feature 'say';
 
 my $ntfy_url   = 'https://ntfy.vps.chriphost.de';
@@ -31,6 +33,19 @@ sub notify_file {
     sleep(1);
 }
 
+sub shell_quote {
+    my ($string) = @_;
+    $string =~ s/'/'"'"'/g;
+    return "'$string'";
+}
+
+sub date_now {
+    my $dt   = DateTime->now( time_zone => 'local' );
+    my $date = $dt->iso8601;
+
+    return $date;
+}
+
 sub rewrite_file {
     my ( $file, $matches, $replacement ) = @_;
 
@@ -67,7 +82,7 @@ sub find_files {
     my ($dir) = @_;
 
     opendir( my $dhandle, $dir ) or die "opendir($dir): $!";
-    my @files = grep { -f "$dir/$_" } readdir($dhandle);
+    my @files = sort grep { -f "$dir/$_" } readdir($dhandle);
     closedir($dhandle);
 
     return @files;
@@ -78,7 +93,7 @@ sub find_subdirs {
 
     opendir( my $dhandle, $dir ) or die "opendir($dir): $!";
     my @subdirs =
-      grep { $_ ne '.' && $_ ne '..' && -d "$dir/$_" } readdir($dhandle);
+      sort grep { $_ ne '.' && $_ ne '..' && -d "$dir/$_" } readdir($dhandle);
     closedir($dhandle);
 
     return @subdirs;
@@ -109,6 +124,7 @@ sub execute_query {
 
     $postprocess->($result);
 
+    system( 'mkdir', '-p', "$builds_dir/$experiment" );
     open( my $results_handle, '>', "$builds_dir/$experiment/$filenamestring" )
       or die "failed to open file: $!";
     print $results_handle $result;

scripts/build.pl

@@ -4,8 +4,16 @@ use strict;
 use warnings;
 use diagnostics;
 
+use FindBin;
+use lib $FindBin::Bin;
+
+use Util;
+use TUI;
+
 use feature 'say';
 
+my $date = Util::date_now;
+
 my $local_root            = '/home/christoph/Notes/TU/MastersThesis/FailNix';
 my $local_builds_dir      = "$local_root/builds";
 my $local_experiments_dir = "$local_root/targets/wasm-module";
@@ -21,52 +29,37 @@ sub just {
       and die "Build failed";
 }
 
-die "Please archive or delete old experiments before building"
+# Find and select experiments
-  if ( -d $local_builds_dir );
+my @experiments = map { s/\.cpp//r } Util::find_files($local_experiments_dir);
-
-# Find experiments
-opendir( my $dhandle, $local_experiments_dir )
-  or die "opendir$local_experiments_dir): $!";
-my @experiments =
-  map { s/\.cpp//r } grep { -f "$local_experiments_dir/$_" } readdir($dhandle);
-closedir($dhandle);
-
-# Select experiments
-say "Experiments:";
-foreach (@experiments) { say " - $_"; }
-print "Enter single experiment name, comma-separated list or \"all\": ";
-my $experiment_sel = <STDIN>;
-chomp $experiment_sel;
 my @selected_experiments =
-  $experiment_sel eq "all" ? @experiments : split( ',', $experiment_sel );
+  TUI::select_from_list( "Select Experiments to Build", 1, @experiments );
+die "No experiment selected" unless @selected_experiments;
 
 # Select targets
-say "Targets:";
-foreach (@targets) { say " - $_"; }
-print "Enter single target, comma-separated list or \"all\": ";
-my $target_sel = <STDIN>;
-chomp $target_sel;
 my @selected_targets =
-  $target_sel eq "all" ? @targets : split( ',', $target_sel );
+  TUI::select_from_list( "Select Targets Platforms", 1, @targets );
+die "No target selected" unless @selected_targets;
 
 # Select modes
-say "Modes:";
+my @selected_modes =
-foreach (@modes) { say " - $_"; }
+  TUI::select_from_list( "Select Execution Modes", 1, @modes );
-print "Enter single mode, comma-separated list or \"all\": ";
+die "No mode selected" unless @selected_modes;
-my $mode_sel = <STDIN>;
-chomp $mode_sel;
-my @selected_modes = $mode_sel eq "all" ? @modes : split( ',', $mode_sel );
 
 # Build everything
+# TODO: linux-baremetal target is broken
 system( "mkdir", "-p", "$local_builds_dir" );
 foreach my $experiment (@selected_experiments) {
     foreach my $target (@selected_targets) {
         foreach my $mode (@selected_modes) {
             just( "build", $experiment, $target, $mode );
             system(
-"mv $local_root/build-$experiment $local_builds_dir/$experiment-$target-$mode"
+                join " ",
+                (
+                    "mv",
+                    "$local_root/build-$experiment",
+                    "$local_builds_dir/${date}_$experiment-$target-$mode",
+                )
             );
-            system("rm -rf $local_root/build-$experiment");
         }
     }
 }

scripts/deploy.pl

@@ -4,118 +4,48 @@ use strict;
 use warnings;
 use diagnostics;
 
-use File::Basename qw(basename);
+use FindBin;
-use Net::OpenSSH;
+use lib $FindBin::Bin;
-use DateTime;
+
-use DBI;
+use Util;
+use Mars;
+use TUI;
 
 use feature 'say';
 
-sub remote {
-    my ( $ssh, @cmd ) = @_;
-    $ssh->system(@cmd);
-    $ssh->error and die "Remote command failed (@cmd): " . $ssh->error;
-}
-
-sub shell_quote {
-    my ($string) = @_;
-    $string =~ s/'/'"'"'/g;
-    return "'$string'";
-}
-
-my $date        = DateTime->now->iso8601;
-my $screen_name = 'smchurla_fail';
-
 my $local_root       = '/home/christoph/Notes/TU/MastersThesis/FailNix';
 my $local_builds_dir = "$local_root/builds";
 
-my $remote_host       = 'mars';    # smchurla@mars.cs.tu-dortmund.de
 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 $remote_log        = "$remote_root/runner.log";
 
-# The mars db is bound to local port 3306 over SSH.
-# - This requires using the configured 'mars'
-#   remote_host instead of smchurla@mars
-#   or setting up another tunnel here
-my $db_host   = "127.0.0.1";
-my $db_port   = "3306";
-my $db_user   = "smchurla";
-my $db_prefix = "$db_user\_$date";
-
-# Database password
-open( my $fhandle, '<', "$local_root/mars-db.conf" )
-  or die "Failed to read mars-db.conf: $!";
-chomp( my $db_password = <$fhandle> );
-close($fhandle);
-
-# Initialize SSH connection
-# - This connection also sets up the database tunnel
-my $ssh = Net::OpenSSH->new(
-    $remote_host,
-    timeout     => 30,
-    master_opts => [
-        -o => 'BatchMode=yes',
-        -o => 'StrictHostKeyChecking=accept-new',
-    ],
-);
-$ssh->error and die 'SSH connection failed: ' . $ssh->error;
-say 'Connected to mars.cs.tu-dortmund.de';
-
-# Pull changes
-# remote( $ssh, 'git', '-C', $remote_root, 'pull' ); # TODO: Requires auth
-
-# Find new experiments
-opendir( my $dhandle, $local_builds_dir )
-  or die "opendir($local_builds_dir): $!";
-my @experiments = grep { $_ ne '.' && $_ ne '..' && -d "$local_builds_dir/$_" }
-  readdir($dhandle);
-closedir($dhandle);
-
 # Upload new experiments
-remote( $ssh, 'mkdir', '-p', $remote_builds_dir );
+my @experiments = Util::find_subdirs($local_builds_dir);
-foreach (@experiments) {
+my @selected_experiments =
-    say " - Uploading $_ to $remote_builds_dir/$date\_$_...";
+  TUI::select_from_list( "Select Experiments to Run", 1, @experiments );
-    $ssh->scp_put(
+die "No experiment selected" unless @selected_experiments;
-        {
+Mars::ssh_system( 'mkdir', '-p', $remote_builds_dir );
-            recursive  => 1,
+Mars::upload_dir( "$local_builds_dir/$_", "$remote_builds_dir/$_" )
-            copy_attrs => 1
+  for @selected_experiments;
-        },
-        "$local_builds_dir/$_",
-        "$remote_builds_dir/$date\_$_"
-    ) or die "Failed to upload $_: " . $ssh->error;
-}
-
-# Initialize db connection
-my $dbh = DBI->connect( "DBI:MariaDB:host=$db_host;port=$db_port",
-    $db_user, $db_password )
-  or die 'Failed to connect to database: ' . $DBI::errstr;
-say 'Connected to database';
-
-say 'Existing databases:';
-my @db_names =
-  sort
-  map { s/DBI:MariaDB://r }
-  grep { !/information_schema|smchurla_ll/ } $dbh->data_sources();
-foreach (@db_names) { say " - $_"; }
 
 # Create dbs for new experiments
+say 'Existing databases:';
+say " - $_" for Mars::db_list();
 say 'Creating databases...';
-foreach (@experiments) {
+Mars::db_create( Mars::db_prefix . "_$_" ) for @experiments;
-    say " - Creating database $db_prefix\_$_...";
-    $dbh->do("create database `$db_prefix\_$_`")
-      or die "Failed to create database: " . $dbh->errstr;
-}
 
 # Launch remote runner
-remote( $ssh,
+Mars::ssh_system(
-        "nohup sh -c "
+    join " ",
-      . shell_quote("cd $remote_root && perl $remote_runner") . " >"
+    (
-      . shell_quote($remote_log)
+        "nohup sh -c",
-      . " 2>&1 < /dev/null &" );
+        Util::shell_quote("cd $remote_root && perl $remote_runner"),
-
+        ">" . Util::shell_quote($remote_log),
+        "2>&1 < /dev/null &"
+    )
+);
 say "Started remote runner for ", scalar(@experiments), " experiments";
 
-$dbh->disconnect or warn $dbh->errstr;
+Mars::db_disconnect();

scripts/dropdb.pl

@@ -1,68 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-use diagnostics;
-
-use Net::OpenSSH;
-use DBI;
-
-use feature 'say';
-
-my $local_root = '/home/christoph/Notes/TU/MastersThesis/FailNix';
-
-my $remote_host = 'mars';    # smchurla@mars.cs.tu-dortmund.de
-
-# The mars db is bound to local port 3306 over SSH.
-# - This requires using the configured 'mars'
-#   remote_host instead of smchurla@mars
-#   or setting up another tunnel here
-my $db_host = "127.0.0.1";
-my $db_port = "3306";
-my $db_user = "smchurla";
-
-# Database password
-open( my $fhandle, '<', "$local_root/mars-db.conf" )
-  or die "Failed to read mars-db.conf: $!";
-chomp( my $db_password = <$fhandle> );
-close($fhandle);
-
-# Initialize SSH connection
-# - This connection also sets up the database tunnel
-my $ssh = Net::OpenSSH->new(
-    $remote_host,
-    timeout     => 30,
-    master_opts => [
-        -o => 'BatchMode=yes',
-        -o => 'StrictHostKeyChecking=accept-new',
-    ],
-);
-$ssh->error and die 'SSH connection failed: ' . $ssh->error;
-say 'Connected to mars.cs.tu-dortmund.de';
-
-# Initialize db connection
-my $dbh = DBI->connect( "DBI:MariaDB:host=$db_host;port=$db_port",
-    $db_user, $db_password )
-  or die 'Failed to connect to database: ' . $DBI::errstr;
-say 'Connected to database';
-
-while (1) {
-    say 'Existing databases:';
-    my @db_names =
-      sort
-      map { s/DBI:MariaDB://r }
-      grep { !/information_schema|smchurla_ll/ } $dbh->data_sources();
-    foreach (@db_names) { say " - $_"; }
-
-    print 'Enter single name or comma-separated list to delete: ';
-    my $db_sel = <STDIN>;
-    chomp $db_sel;
-    my @selected_dbs = $db_sel eq "all" ? @db_names : split( ',', $db_sel );
-    foreach (@selected_dbs) {
-        $dbh->do("drop database `$_`")
-          or die "Failed to drop database: " . $dbh->errstr;
-
-    }
-}
-
-$dbh->disconnect or warn $dbh->errstr;

scripts/menu.pl

@@ -0,0 +1,221 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use diagnostics;
+
+use FindBin;
+use lib $FindBin::Bin;
+
+use Util;
+use Mars;
+use TUI;
+
+use feature 'say';
+
+my $local_root            = '/home/christoph/Notes/TU/MastersThesis/FailNix';
+my $local_scripts_dir     = "$local_root/scripts";
+my $local_builds_dir      = "$local_root/builds";
+my $local_archive_dir     = "$local_root/injections";
+my $local_charts_dir      = "$local_root/charts";
+my $local_ghidra_projects = "$local_root/ghidra/projects";
+my $local_ghidra_scripts  = "$local_root/ghidra/scripts";
+my $local_db_conf         = "$local_root/db.conf";
+
+my $remote_root       = '/home/lab/smchurla/Documents/failnix';
+my $remote_builds_dir = "$remote_root/builds";
+
+my %handlers = (
+    '01. Build Experiments' => sub { do "$local_scripts_dir/build.pl"; },
+
+    '02. Deploy Experiments (Mars)' =>
+      sub { do "$local_scripts_dir/deploy.pl"; },
+
+    '03. Archive Experiments (Downloads from Mars)' => sub {
+
+        # Download ran experiments from mars
+        my @dirs = Mars::find_remote_subdirs($remote_builds_dir);
+        my @selected_dirs =
+          TUI::select_from_list( "Select Experiments to Download", 1, @dirs );
+        die "No experiment selected" unless @selected_dirs;
+        Mars::download_dir( "$remote_builds_dir/$_", "$local_archive_dir/$_" )
+          for @selected_dirs;
+    },
+
+    '04. Query Databases (Mars)' => sub {
+
+        # Select databases
+        my @db_names = Mars::db_list();
+        my @selected_dbs =
+          TUI::select_from_list( "Select Databases to Query", 1, @db_names );
+        die "No database selected" unless @selected_dbs;
+
+        # Select queries
+        my @queries =
+          map { s/\.pm//r } Util::find_files("$local_root/scripts/Queries");
+        my @selected_queries =
+          TUI::select_from_list( "Select Queries to Run", 1, @queries );
+        die "No query selected" unless @selected_queries;
+
+        # Run queries on databases
+        foreach my $db (@selected_dbs) {
+            foreach my $query (@selected_queries) {
+                Util::rewrite_file( $local_db_conf, "database=",
+                    "database=$db\n" );
+
+                say "Running $query on $db...";
+                Util::execute_query( $db =~ s/smchurla_//r,
+                    $query, $local_db_conf, $local_archive_dir, 0 );
+            }
+        }
+    },
+
+    '05. Import Experiments Into Ghidra' => sub {
+
+        # Import archived experiments into ghidra
+        my @dirs = Util::find_subdirs($local_archive_dir);
+        my @selected_dirs =
+          TUI::select_from_list( "Select Experiments to Import", 1, @dirs );
+        foreach (@selected_dirs) {
+            say "Creating Ghidra project for $_...";
+            system(
+                'ghidra-analyzeHeadless',
+
+                $local_ghidra_projects, $_ =~ s/:/-/gr,
+                '-import',              "$local_archive_dir/$_/system.elf",
+                '-scriptPath',          $local_ghidra_scripts,
+                '-postScript',          'DWARFLineInfoSourceMapScript',
+                '-postScript',          'DWARFLineInfoCommentScript',
+                '-postScript',          'ImportMarkersAsBookmarks',
+                "$local_archive_dir/$_/faults.csv"
+            );
+        }
+    },
+
+    '06. Plot Results' => sub {
+
+        # Generate R ggplot2 charts
+        my @experiments = Util::find_subdirs($local_archive_dir);
+        my @selected_experiments =
+          TUI::select_from_list( "Select Experiments to Plot", 1,
+            @experiments );
+        die "No experiment selected" unless @selected_experiments;
+
+        my @charts = map { s/\.r//r } Util::find_files($local_charts_dir);
+        my @selected_charts =
+          TUI::select_from_list( "Select Plots to Generate", 1, @charts );
+        die "No plot selected" unless @selected_charts;
+
+        my @single_charts = grep { /single/ } @selected_charts;
+        foreach my $experiment (@selected_experiments) {
+            foreach my $chart (@single_charts) {
+                say " - Generating plot $chart for $experiment...";
+                system(
+                    'Rscript',
+                    "$local_charts_dir/$chart.r",
+                    "$local_archive_dir/$experiment"
+                );
+            }
+        }
+
+        my @combined_charts   = grep { /combined/ } @selected_charts;
+        my $print_experiments = join " ", @selected_experiments;
+        my @path_experiments =
+          map { "$local_archive_dir/$_" } @selected_experiments;
+        foreach my $chart (@combined_charts) {
+            say " - Generating plot $chart for ($print_experiments)...";
+            system( 'Rscript', "$local_charts_dir/$chart.r",
+                @path_experiments );
+        }
+    },
+
+    '10. Open Experiment in Ghidra' => sub {
+
+        my @projects =
+          map { s/\.gpr//r } Util::find_files($local_ghidra_projects);
+        my @selected_projects =
+          TUI::select_from_list( "Select Project to Open in Ghidra",
+            0, @projects );
+        die "No project selected" unless @selected_projects;
+        my $project = $selected_projects[0];
+        system(
+            join " ",
+            (
+                "_JAVA_AWT_WM_NONREPARENTING=1", "ghidra",
+                "$local_ghidra_projects/$project.gpr",
+            )
+        );
+    },
+
+    '11. Open Experiment In Explorer' =>
+      sub { do "$local_scripts_dir/explore.pl" },
+
+    '95. Delete Builds (Local)' => sub {
+
+        # Delete old build files
+        my @builds = Util::find_subdirs($local_builds_dir);
+        my @selected_builds =
+          TUI::select_from_list( "Select Builds to Delete", 1, @builds );
+        die "No builds selected" unless @selected_builds;
+        system( 'rm', '-rf', "$local_builds_dir/$_" ) for @selected_builds;
+    },
+
+    '96. Delete Builds (Mars)' => sub {
+
+        # Delete ran experiments from mars
+        my @builds = Mars::find_remote_subdirs($remote_builds_dir);
+        my @selected_builds =
+          TUI::select_from_list( "Select Experiments to Delete", 1, @builds );
+        die "No experiment selected" unless @selected_builds;
+        Mars::ssh_system( 'rm', '-rf', "$remote_builds_dir/$_" )
+          for @selected_builds;
+    },
+
+    '97. Delete Ghidra Projects' => sub {
+
+        # Delete ghidra projects
+        my @projects =
+          map { s/\.gpr//r } Util::find_files($local_ghidra_projects);
+        my @selected_projects =
+          TUI::select_from_list( "Select Projects to Delete", 1, @projects );
+        die "No projects selected" unless @selected_projects;
+        system( 'rm', '-rf', "$local_ghidra_projects/$_.gpr" )
+          for @selected_projects;
+        system( 'rm', '-rf', "$local_ghidra_projects/$_.rep" )
+          for @selected_projects;
+    },
+
+    '98. Delete Archived Experiments' => sub {
+
+        # Delete archived experiments
+        my @experiments = Util::find_subdirs($local_archive_dir);
+        my @selected_experiments =
+          TUI::select_from_list( "Select Archived Experiments to Delete",
+            1, @experiments );
+        die "No experiments selected" unless @selected_experiments;
+        system( 'rm', '-rf', "$local_archive_dir/$_" )
+          for @selected_experiments;
+    },
+
+    '99. Drop Databases (Mars)' => sub {
+
+        # Drop databases on mars
+        my @db_names = Mars::db_list();
+        my @selected_dbs =
+          TUI::select_from_list( "Select Databases to Drop", 1, @db_names );
+        die "No database selected" unless @selected_dbs;
+        Mars::db_drop($_) for @selected_dbs;
+    },
+);
+
+while (1) {
+    my @submenu =
+      TUI::select_from_list( "FailNix Menu", 0, sort keys %handlers );
+    die "No action selected" unless @submenu;
+
+    say @submenu;
+
+    eval { $handlers{ $submenu[0] }(); }
+}
+
+Mars::db_disconnect();