diff --git a/flake.nix b/flake.nix index 724bb5f..a36412a 100644 --- a/flake.nix +++ b/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}" diff --git a/scripts/Mars.pm b/scripts/Mars.pm new file mode 100644 index 0000000..4914049 --- /dev/null +++ b/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; diff --git a/scripts/Queries/Faults.pm b/scripts/Queries/Faults.pm new file mode 100644 index 0000000..d6962f6 --- /dev/null +++ b/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; diff --git a/scripts/Queries/FaultsDetected.pm b/scripts/Queries/FaultsDetected.pm deleted file mode 100644 index 94cee9c..0000000 --- a/scripts/Queries/FaultsDetected.pm +++ /dev/null @@ -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; diff --git a/scripts/Queries/FaultsFailed.pm b/scripts/Queries/FaultsFailed.pm deleted file mode 100644 index d3ac6f9..0000000 --- a/scripts/Queries/FaultsFailed.pm +++ /dev/null @@ -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; diff --git a/scripts/Queries/FaultsOuterspace.pm b/scripts/Queries/FaultsOuterspace.pm deleted file mode 100644 index c823dcb..0000000 --- a/scripts/Queries/FaultsOuterspace.pm +++ /dev/null @@ -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; diff --git a/scripts/Queries/FaultsTimeout.pm b/scripts/Queries/FaultsTimeout.pm deleted file mode 100644 index 097ed28..0000000 --- a/scripts/Queries/FaultsTimeout.pm +++ /dev/null @@ -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; diff --git a/scripts/Queries/FaultsTrap.pm b/scripts/Queries/FaultsTrap.pm deleted file mode 100644 index be34bf0..0000000 --- a/scripts/Queries/FaultsTrap.pm +++ /dev/null @@ -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; diff --git a/scripts/Queries/Results.pm b/scripts/Queries/Results.pm index d444f41..e3f7b5e 100644 --- a/scripts/Queries/Results.pm +++ b/scripts/Queries/Results.pm @@ -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 diff --git a/scripts/Queries/ResultsData.pm b/scripts/Queries/ResultsData.pm new file mode 100644 index 0000000..37ca851 --- /dev/null +++ b/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; diff --git a/scripts/TUI.pm b/scripts/TUI.pm new file mode 100644 index 0000000..51afd02 --- /dev/null +++ b/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; diff --git a/scripts/Util.pm b/scripts/Util.pm index 495083c..2a37d86 100644 --- a/scripts/Util.pm +++ b/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; diff --git a/scripts/build.pl b/scripts/build.pl index ca2bcb0..c53ca58 100755 --- a/scripts/build.pl +++ b/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" - 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 = ; -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 = ; -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 = ; -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"); } } } diff --git a/scripts/deploy.pl b/scripts/deploy.pl index 7e34d77..4212e95 100755 --- a/scripts/deploy.pl +++ b/scripts/deploy.pl @@ -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(); diff --git a/scripts/dropdb.pl b/scripts/dropdb.pl deleted file mode 100755 index 1571d0f..0000000 --- a/scripts/dropdb.pl +++ /dev/null @@ -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 = ; - 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; diff --git a/scripts/menu.pl b/scripts/menu.pl new file mode 100644 index 0000000..fc7d142 --- /dev/null +++ b/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();