christoph/failnix
1
Fork 0
Code Releases Activity

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

Browse Source
This commit is contained in:
Christoph Urlacher
2026-04-20 00:16:27 +02:00
parent 9c7933e912
commit 5b316bbd64
16 changed files with 622 additions and 349 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
flake.nix
View File

@ -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}"

180
scripts/Mars.pm Normal file
View File

@ -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;

29
scripts/Queries/Faults.pm Normal file
View File

@ -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;

30
scripts/Queries/FaultsDetected.pm
View File

@ -1,30 +0,0 @@
package Queries::FaultsDetected;
use strict;
use warnings;
use diagnostics;
sub query {
my ($experiment) = @_;
my $resulttype = 'DETECTED_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_detected.csv"; }
sub postprocess { $_[0] =~ s/\t/,/g; }
1;

30
scripts/Queries/FaultsFailed.pm
View File

@ -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;

30
scripts/Queries/FaultsOuterspace.pm
View File

@ -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;

30
scripts/Queries/FaultsTimeout.pm
View File

@ -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;

30
scripts/Queries/FaultsTrap.pm
View File

@ -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;

4
scripts/Queries/Results.pm
View File

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

28
scripts/Queries/ResultsData.pm Normal file
View File

@ -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;

92
scripts/TUI.pm Normal file
View File

@ -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;

20
scripts/Util.pm
View File

@ -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;

55
scripts/build.pl
View File

@ -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"
if ( -d $local_builds_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;
# Find and select experiments
my @experiments = map { s/\.cpp//r } Util::find_files($local_experiments_dir);
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:";
foreach (@modes) { say " - $_"; }
print "Enter single mode, comma-separated list or \"all\": ";
my $mode_sel = <STDIN>;
chomp $mode_sel;
my @selected_modes = $mode_sel eq "all" ? @modes : split( ',', $mode_sel );
my @selected_modes =
TUI::select_from_list( "Select Execution Modes", 1, @modes );
die "No mode selected" unless @selected_modes;
# 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");
}
}
}

122
scripts/deploy.pl
View File

@ -4,118 +4,48 @@ use strict;
use warnings;
use diagnostics;
use File::Basename qw(basename);
use Net::OpenSSH;
use DateTime;
use DBI;
use FindBin;
use lib $FindBin::Bin;
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 );
foreach (@experiments) {
say " - Uploading $_ to $remote_builds_dir/$date\_$_...";
$ssh->scp_put(
{
recursive => 1,
copy_attrs => 1
},
"$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 " - $_"; }
my @experiments = Util::find_subdirs($local_builds_dir);
my @selected_experiments =
TUI::select_from_list( "Select Experiments to Run", 1, @experiments );
die "No experiment selected" unless @selected_experiments;
Mars::ssh_system( 'mkdir', '-p', $remote_builds_dir );
Mars::upload_dir( "$local_builds_dir/$_", "$remote_builds_dir/$_" )
for @selected_experiments;
# Create dbs for new experiments
say 'Existing databases:';
say " - $_" for Mars::db_list();
say 'Creating databases...';
foreach (@experiments) {
say " - Creating database $db_prefix\_$_...";
$dbh->do("create database `$db_prefix\_$_`")
or die "Failed to create database: " . $dbh->errstr;
}
Mars::db_create( Mars::db_prefix . "_$_" ) for @experiments;
# Launch remote runner
remote( $ssh,
"nohup sh -c "
. shell_quote("cd $remote_root && perl $remote_runner") . " >"
. shell_quote($remote_log)
. " 2>&1 < /dev/null &" );
Mars::ssh_system(
join " ",
(
"nohup sh -c",
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();

68
scripts/dropdb.pl
View File

@ -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;

221
scripts/menu.pl Normal file
View File

@ -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();