#!/usr/bin/env perl use strict; use warnings; use diagnostics; use FindBin; use lib "$FindBin::Bin/Modules"; use Util; use Mars; use TUI; use Filters; use File::Temp; use Text::CSV_XS; use feature 'say'; # TODO: Much can be extracted into utility functions my $local_obsidian = '/home/christoph/Notes/Obsidian/Chriphost'; my $local_obsidian_attach = "$local_obsidian/attach"; my $local_newlib = '/home/christoph/Notes/TU/MastersThesis/07 NewLib'; my $local_root = '/home/christoph/Notes/TU/MastersThesis/FailNix'; my $local_wamr = "$local_root/wamr"; my $local_scripts_dir = "$local_root/scripts"; my $local_builds_dir = "$local_root/builds"; my $local_archive_dir = "$local_root/injections"; my $local_queries_dir = "$local_root/queries"; my $local_charts_dir = "$local_root/scripts/charts"; my $local_charts_out_dir = "$local_root/charts"; my $local_ghidra_projects = "$local_root/ghidra"; my $local_ghidra_scripts = "$local_root/scripts/ghidra"; my $local_dump_dir = "$local_root/dumps"; my $local_db_conf = "$local_root/db.conf"; my $resultbrowser_port = '5000'; my $resultbrowser = 'resultbrowser.py'; my $qemu_gdb_port = '9000'; my $remote_root = '/home/lab/smchurla/Documents/failnix'; my $remote_builds_dir = "$remote_root/builds"; my $db_host = "127.0.0.1"; my $db_port = "3306"; my $db_user = "smchurla"; my %handlers = ( '01. Build Experiments' => sub { do qq{$local_scripts_dir/build.pl}; }, '02. Deploy Experiments (Mars)' => sub { do qq{$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 @existing = Util::find_subdirs($local_archive_dir); my @new_dirs; foreach (@dirs) { my $dir = $_ =~ s/:/-/gr; unless ( grep { /$dir/ } @existing ) { push @new_dirs, $_; } } my @selected_dirs = TUI::select_from_list( "Select Experiments to Download from Mars", 1, @new_dirs ); die "No experiment selected" unless @selected_dirs; Mars::download_dir( "$remote_builds_dir/$_", "$local_archive_dir/" . $_ =~ s/:/-/gr ) 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; # Sucks to put those here but the chart descriptions are there aswell my %query_descriptions = ( Faults => 'Faults by benchmark, resulttype and fault address with mnemonic (faults.csv)', Mnemonics => 'Instruction count per mnemonic across read equivalence classes (mnemonics.csv)', RegionMarker => 'Faults by code region with resulttype (regionmarker.csv)', Results => 'Same as ResultsData but as a table (results.txt)', ResultsData => 'Faults summary per benchmark with resulttype (resultsdata.csv)', ResultsDataPruned => 'Faults summary per benchmark with resulttype, using the pruned data without expansion (resultsdata_pruned.csv)', ResultsDataWriteGroups => 'Faults summary per benchmark with resulttype, with write equivalence classes reconstructed from fsppilot (resultsdata_writegroups.csv)', TargetClass => 'Faults by code type with data type (stack/heap/bss/...) and resulttype -> targetclass.csv', TraceWeight => 'Total cycle count vs performed pilots per benchmark (traceweight.csv)', ); 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, \%query_descriptions ); die "No query selected" unless @selected_queries; # Select filter configs (they're combined into one) my @filter_choices; my %filter_label_name; my $configs = Filters::get_configs(); foreach my $name ( sort keys %$configs ) { my $label = $configs->{$name}{label}; push @filter_choices, $label; $filter_label_name{$label} = $name; } my @selected_filter_labels = TUI::select_from_list( "Select Filters to Apply (none = unfiltered)", 1, @filter_choices ); my @filter_configs = map { $filter_label_name{$_} } @selected_filter_labels; # Run queries on databases foreach my $db (@selected_dbs) { my $experiment = $db =~ s/smchurla_//r; my $variant_name = Mars::db_variant_name($db); if ( !defined $variant_name ) { say "Skipping $db: contains multiple variants"; next; } if ( $variant_name ne $experiment ) { say "Skipping $db: the variant is '$variant_name' but the queries use '$experiment'."; next; } foreach my $query (@selected_queries) { Util::rewrite_file( $local_db_conf, "database=", "database=$db\n" ); my $config_label = @filter_configs ? " (" . join( "+", @filter_configs ) . ")" : ""; say "Running $query$config_label on $db..."; Util::execute_query( $experiment, $query, $local_db_conf, "$local_archive_dir/$experiment", $local_queries_dir, "${experiment}_", 0, @filter_configs ); } } }, '05. Import Experiments Into Ghidra' => sub { my @existing = Util::find_files($local_ghidra_projects); # Determine if an experiment was already imported my $project_exists = sub { my ($name) = @_; $name =~ s/:/-/g; return grep { /^$name.gpr$/ } @existing; }; # Import archived experiments into ghidra my @dirs = grep { !$project_exists->($_) } Util::find_subdirs($local_archive_dir); my @dirs_with_notes; foreach my $dir (@dirs) { my $info = Util::read_experiment_info($dir); push @dirs_with_notes, ( defined $info && length($info) > 0 ) ? sprintf( "%-50s (%s)", $dir, $info ) : $dir; } my @selected_dirs = TUI::select_from_list( "Select Experiments to Import into Ghidra", 1, @dirs_with_notes ); foreach (@selected_dirs) { my $experiment = $_ =~ s/(.*?)\s+\(.+\)$/$1/r; my $faults_csv = "$local_queries_dir/${experiment}_faults.csv"; unless ( -f $faults_csv ) { say "Skipping $experiment: $faults_csv does not exist"; next; } say "Creating Ghidra project for $experiment..."; system( 'ghidra-analyzeHeadless', $local_ghidra_projects, $experiment =~ s/:/-/gr, '-import', "$local_archive_dir/$experiment/system.elf", '-scriptPath', $local_ghidra_scripts, '-postScript', 'DWARFLineInfoSourceMapScript', '-postScript', 'DWARFLineInfoCommentScript', '-postScript', 'ImportMarkersAsBookmarks', $faults_csv ); } }, '06. Import Experiments Into Obsidian' => sub { my @experiments = Util::find_subdirs($local_archive_dir); # Filter experiments that already have notes my @new_experiments; my @existing_notes = split "\n", qx{obsidian files}; foreach my $experiment (@experiments) { push @new_experiments, $experiment unless ( grep { /zettel\/$experiment/ } @existing_notes ); } my @selected_experiments = TUI::select_from_list( "Select Experiments to Import into Obsidian", 1, @new_experiments ); die "No experiment selected" unless @selected_experiments; foreach my $experiment (@selected_experiments) { # Create note system( 'obsidian', 'create', "name=$experiment", 'path=zettel', 'template=FailExperiment', 'open', 'newtab' ); # Insert results my $results_txt = "$local_queries_dir/${experiment}_results_no_native_call_data+no_native_call_instr.txt"; if ( -f $results_txt ) { open( my $fhandle, '<', $results_txt ) or return; my $results = join "", <$fhandle>; close($fhandle); # Append link to results file system( 'obsidian', 'append', "file=zettel/$experiment", "content=## Results\n\n[Results File](file://$results_txt)\n\n" ); # Append results as markdown block system( 'obsidian', 'append', "file=zettel/$experiment", "content=```\n$results```\n" ); } else { say "$results_txt does not exist"; } # Insert charts system( 'obsidian', 'append', "file=zettel/$experiment", "content=## Charts\n\n" ); my $attach_image = sub { my ($name) = @_; my $image = "$local_charts_out_dir/${experiment}_$name.svg"; unless ( -f $image ) { say "$image does not exist"; return; } system( 'obsidian', 'append', "file=zettel/$experiment", "content=![$name](file://$image)\n" ); }; $attach_image->( "single_result_no_native_call_data+no_native_call_instr"); $attach_image->("scatter_no_native_call_data+no_native_call_instr"); } }, '10. Explore Experiment Results' => sub { do qq{$local_scripts_dir/explore.pl}; }, '11. Compare Experiment Results' => sub { my @selected_experiments = Util::select_experiment(1); # TODO: Fails silently if not every selected experiment has this datafile my $resultsdata_csv = Util::pick_query_file( $selected_experiments[0], "resultsdata" ); # Read results my %all_results; foreach my $experiment (@selected_experiments) { # Schema: benchmark, resulttype, faults my $data = Text::CSV_XS::csv( in => "$local_queries_dir/${experiment}_$resultsdata_csv", headers => 'auto' ); foreach my $row (@$data) { $all_results{$experiment}{ $row->{benchmark} } { $row->{resulttype} } = $row->{faults}; } } my @benchs = ( 'ip', 'mem', 'regs' ); my @markers = ( 'OK_MARKER', 'FAIL_MARKER', 'DETECTED_MARKER', 'TIMEOUT', 'TRAP', 'WRITE_TEXTSEGMENT', 'ACCESS_OUTERSPACE', 'GROUP1_MARKER' ); my $heading = sprintf( "%5s %20s ", "BENCH", "TYPE" ); my $subheading = sprintf( "%5s %20s ", "", "" ); foreach my $experiment (@selected_experiments) { $heading .= sprintf( "%50s ", $experiment ); $subheading .= sprintf( "%50s ", Util::read_experiment_info($experiment) ); } my @entries = ( $heading, $subheading, "" ); foreach my $benchmark (@benchs) { foreach my $marker (@markers) { my $entry = sprintf( "%5s %20s ", $benchmark, $marker ); foreach my $experiment (@selected_experiments) { if ( exists $all_results{$experiment}{$benchmark}{$marker} ) { $entry .= sprintf( "%50s ", Util::format_number_sep( $all_results{$experiment}{$benchmark}{$marker} ) ); } else { $entry .= sprintf( "%50s ", "" ); } } push @entries, $entry; } push @entries, ""; } TUI::select_from_list( "Comparing " . scalar(@selected_experiments) . " Experiments", 0, @entries ); }, # '11b. Compare to Baseline' => sub { # # my $baseline = Util::select_experiment(0); # # my @selected_experiments = Util::select_experiment(1); # # # TODO: Fails silently if not every selected experiment has this datafile # my $resultsdata_csv = # Util::pick_query_file( $baseline, "resultsdata" ); # # my %all_results; # foreach my $experiment ( $baseline, @selected_experiments ) { # # my $data = Text::CSV_XS::csv( # in => "$local_queries_dir/${experiment}_$resultsdata_csv", # headers => 'auto' # ); # # foreach my $row (@$data) { # $all_results{$experiment}{ $row->{benchmark} } # { $row->{resulttype} } = $row->{faults}; # } # } # # my @benchs = ( 'ip', 'mem', 'regs' ); # my @markers = ( # 'OK_MARKER', 'FAIL_MARKER', # 'DETECTED_MARKER', 'TIMEOUT', # 'TRAP', 'WRITE_TEXTSEGMENT', # 'ACCESS_OUTERSPACE', 'GROUP1_MARKER' # ); # # my $heading = sprintf( "%5s %20s %50s ", "BENCH", "TYPE", $baseline ); # my $subheading = sprintf( "%5s %20s %50s ", # "", "", Util::read_experiment_info($baseline) ); # foreach my $experiment (@selected_experiments) { # $heading .= sprintf( "%50s ", $experiment ); # $subheading .= # sprintf( "%50s ", Util::read_experiment_info($experiment) ); # } # # my @entries = ( $heading, $subheading, "" ); # foreach my $benchmark (@benchs) { # foreach my $marker (@markers) { # my $entry = sprintf( "%5s %20s ", $benchmark, $marker ); # # if ( exists $all_results{$baseline}{$benchmark}{$marker} ) { # $entry .= sprintf( # "%50s ", # Util::format_number_sep( # $all_results{$baseline}{$benchmark}{$marker} # ) # ); # } # else { # $entry .= sprintf( "%50s ", "" ); # } # # foreach my $experiment (@selected_experiments) { # if ( exists $all_results{$baseline}{$benchmark}{$marker} # and # exists $all_results{$experiment}{$benchmark}{$marker} # and $all_results{$baseline}{$benchmark}{$marker} != 0 ) # { # my $factor = # $all_results{$experiment}{$benchmark}{$marker} / # $all_results{$baseline}{$benchmark}{$marker}; # $entry .= # sprintf( "%50s ", sprintf( "%.2fx", $factor ) ); # } # else { # $entry .= sprintf( "%50s ", "" ); # } # } # # push @entries, $entry; # } # push @entries, ""; # } # # TUI::select_from_list( # "Baseline: $baseline — Comparing " # . scalar(@selected_experiments) # . " Experiments", # 0, @entries # ); # }, '12. Open Experiment in BinaryNinja' => sub { my @selected_experiments = Util::select_experiment(1); my @paths = map { "$local_archive_dir/$_/system.elf" } @selected_experiments; system( 'binaryninja', @paths ); }, '13. Open Experiment in Binsider' => sub { my $selected_experiment = Util::select_experiment(0); system( 'binsider', "$local_archive_dir/$selected_experiment/system.elf" ); }, '14. 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", ) ); }, '15. Run Objdump on Experiment' => sub { my $selected_experiment = Util::select_experiment(0); system( "objdump $local_archive_dir/$selected_experiment/system.elf -D -M intel -S | bat --color never" ); }, '16. Run Wasm-Objdump on Experiment' => sub { my $selected_experiment = Util::select_experiment(0); system( "wasm-objdump -d $local_archive_dir/$selected_experiment/wasm_module.wasm | bat --color never" ); }, '17. Run Radare2 on Experiment' => sub { my $selected_experiment = Util::select_experiment(0); say "Radare help:"; say "s
- Seek to address"; say "pd - Disassemble n instructions"; say "pdf - Disassemble current function"; say "pdf @ - Disassemble function"; say "pdr - Disassemble recursively"; say "V - Switch view"; say "p - Switch print mode"; say "P - Switch layout"; system( 'radare2', '-AA', '-c', '"-s dbg.os_main"', '-e', 'scr.color=3', '-e', 'scr.scrollbar=0', '-e', 'scr.responsive=true', '-e', 'scr.interactive=true', '-e', 'scr.utf8=true', '-e', 'scr.utf8.curvy=true', '-e', 'asm.syntax=intel', '-e', 'asm.lines=false', '-e', 'asm.xrefs=true', '-e', 'asm.flags=true', '-e', 'asm.comments=true', '-e', 'asm.functions=true', '-e', 'asm.var=true', '-e', 'asm.cmt.right=true', '-e', 'asm.dwarf=true', '-e', 'asm.pseudo=false', '-e', 'asm.describe=false', '-e', 'bin.relocs.apply=true', "$local_archive_dir/$selected_experiment/system.elf", ); }, '18. Open Database in ResultBrowser (Mars)' => sub { my @db_names = Mars::db_list(); my @selected_dbs = TUI::select_from_list( "Select Database for ResultBrowser", 0, @db_names ); die "No database selected" unless @selected_dbs; my $selected_db = $selected_dbs[0]; Util::rewrite_file( $local_db_conf, "database=", "database=$selected_db\n" ); system( $resultbrowser, '-c', $local_db_conf, '--host=0.0.0.0', "--port=$resultbrowser_port" ); }, '19. Open Database in LazySQL (Mars)' => sub { my $experiment = Util::select_experiment(0) =~ s/T(\d\d)-(\d\d)-(\d\d)/T$1:$2:$3/r; my $ssh = Mars::ssh_connect(); my $db_password = Mars::read_db_password_file(); system( 'lazysql', '-read-only', "mariadb://$db_user:$db_password\@$db_host:$db_port/${db_user}_$experiment" ); }, '20. Open TablePlus (Mars)' => sub { system('tableplus'); }, '21. Run Build in GDB' => sub { my @builds = grep { /linux/ } Util::find_subdirs($local_builds_dir); my @selected_builds = TUI::select_from_list( "Select Build to Run in GDB", 0, @builds ); die "No build selected" unless @selected_builds; my $selected_build = $selected_builds[0]; my $build_dir = "$local_builds_dir/$selected_build"; my $build_name = $selected_build =~ s/.*?_.*?_(.*?)_.*$/$1/r; my $is_baremetal = $selected_build =~ /linux-baremetal$/; my $is_wasm = $build_name eq 'aot' || $build_name eq 'interp'; say "$build_name"; # Baremetal builds boot the iso in qemu and attach gdb my $qemu_pid; if ($is_baremetal) { say "Forking..."; $qemu_pid = fork(); die "fork failed: $!\n" unless defined $qemu_pid; if ( $qemu_pid == 0 ) { # child -> qemu. exec( 'qemu-system-i386', '-drive', "file=$build_dir/system.iso,media=cdrom", '-boot', 'd', '-m', '32', '-D', "$local_root/qemu.log", '-d', "int,cpu_reset", '-no-reboot', '-no-shutdown', '-S', '-gdb', "tcp::$qemu_gdb_port", ) or die "failed to exec qemu: $!\n"; } } # Shared gdb args my @gdb_args = ( '--tui', '-q', "$build_dir/system.elf", '-ex', 'set disassembly-flavor intel', '-ex', "set substitute-path 'build-$build_name' '$build_dir'", '-ex', "set substitute-path '/build/source/core' '$local_wamr/core'", ); # Specific gdb args if ($is_baremetal) { push @gdb_args, '-ex', "target remote localhost:$qemu_gdb_port", '-ex', 'break os_main'; } else { push @gdb_args, '-ex', 'break main'; } # Shared breakpoints my @shared_breakpoints = ( 'fail_start_trace', 'fail_stop_trace', 'fail_marker_positive', 'fail_marker_detected', 'fail_marker_negative', ); # Breakpoints for native C my @c_breakpoints = (); # Breakpoints for Wasm my @wasm_breakpoints = ( 'fail_marker_group1', # 'os_mmap', # 'wamr_malloc', # 'wamr_realloc', # 'wamr_free', ); my @breakpoints = ( @shared_breakpoints, $is_wasm ? @wasm_breakpoints : @c_breakpoints, ); push @gdb_args, '-ex', "break $_" for @breakpoints; # Autostart execution push @gdb_args, '-ex', ( $is_baremetal ? 'continue' : 'run' ); system( 'gdb', @gdb_args ); if ($is_baremetal) { say "Killing qemu with pid $qemu_pid..."; kill 'TERM', $qemu_pid; waitpid( $qemu_pid, 0 ); } }, '30. Plot Results' => sub { # Generate R ggplot2 charts my @selected_experiments = Util::select_experiment(1); # Sucks to put those here but I can't write them inside the R scripts my %chart_descriptions = ( combined_fault_count_comparison => 'faults per benchmark, c/aot/interp side by side (resultsdata.csv).', combined_fault_count_correlation => 'correlation of raw aot vs. interp fault counts (resultsdata.csv).', combined_fault_probability => 'marker probability per fault space (resultsdata.csv [+ traceweight.csv]).', combined_fault_probability_merged => 'marker probability per fault space, ip/mem/regs merged (resultsdata.csv).', combined_fault_rates_per_instruction => 'faults normalised by instruction count (faults.csv + mnemonics.csv).', combined_instr_fault_correlation => 'correlation of instruction frequency vs. faults (faults.csv + mnemonics.csv).', combined_ratio_comparison_merged => 'resulttype ratios to C, summed benchmarks (resultsdata.csv).', combined_ratio_comparison => 'resulttype ratios to C, separate benchmarks (resultsdata.csv).', combined_sankey => 'Sankey flow of markers between two experiments (faults.csv).', single_heatmap => 'address-space heatmap of faults per benchmark (faults.csv).', single_scatter => 'fault address vs. fault count scatter (faults.csv).', single_result => 'fault types per benchmark bar chart (resultsdata.csv).', ); 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, \%chart_descriptions ); die "No plot selected" unless @selected_charts; # Need to know which chart uses which datafile my @faults_charts = grep { /_heatmap|_scatter|_sankey|_instr_fault_correlation|fault_rates_per_instruction/ } @selected_charts; my @resultsdata_charts = grep { /_result|_fault_count_comparison|_ratio_comparison|_fault_count_correlation|_fault_probability/ } @selected_charts; # Select if faults.csv or a filtered variant should be used my $faults_csv; if (@faults_charts) { $faults_csv = Util::pick_query_file( $selected_experiments[0], "faults" ); } # Select if resultsdata.csv or a filtered variant should be used my $resultsdata_csv; if (@resultsdata_charts) { $resultsdata_csv = Util::pick_query_file( $selected_experiments[0], "resultsdata" ); } # Chart SVGs are written into a separate output directory system( 'mkdir', '-p', $local_charts_out_dir ); # Plot single-experiment charts # Args: [] # [datafile] my @single_charts = grep { /single/ } @selected_charts; foreach my $experiment (@selected_experiments) { foreach my $chart (@single_charts) { say " - Generating plot $chart for $experiment..."; my @r_args = ( 'Rscript', "$local_charts_dir/$chart.r", $experiment, $local_queries_dir, $local_charts_out_dir ); # single_heatmap also needs the experiment's system.elf push @r_args, $local_archive_dir if $chart eq 'single_heatmap'; # If the chart is marked in @faults_charts, # append the $faults_csv to the args push @r_args, $faults_csv if defined $faults_csv && grep { $_ eq $chart } @faults_charts; # If the chart is marked in @resultsdata_charts, # append the $resultsdata_csv to the args push @r_args, $resultsdata_csv if defined $resultsdata_csv && grep { $_ eq $chart } @resultsdata_charts; system(@r_args); } } # Plot combined charts # Args: ... # [datafile] my @combined_charts = grep { /combined/ } @selected_charts; my $print_experiments = join " ", @selected_experiments; foreach my $chart (@combined_charts) { say " - Generating plot $chart for ($print_experiments)..."; my @r_args = ( 'Rscript', "$local_charts_dir/$chart.r", @selected_experiments, $local_queries_dir, $local_charts_out_dir ); # If the chart is marked in @faults_charts, # append the $faults_csv to the args push @r_args, $faults_csv if defined $faults_csv && grep { $_ eq $chart } @faults_charts; # If the chart is marked in @resultsdata_charts, # append the $resultsdata_csv to the args push @r_args, $resultsdata_csv if defined $resultsdata_csv && grep { $_ eq $chart } @resultsdata_charts; system(@r_args); } }, '31. Dump Database (Mars)' => sub { # Dump databases from mars into $local_dump_dir my @dbs = Mars::db_list(); my @dbs_with_notes; foreach my $db (@dbs) { my $info = Util::read_experiment_info( $db =~ s/smchurla_//r =~ s/:/-/gr ); push @dbs_with_notes, ( defined $info && length($info) > 0 ) ? sprintf( "%-60s (%s)", $db, $info ) : $db; } my @selected_dbs = TUI::select_from_list( "Select Databases to Dump from Mars", 1, @dbs_with_notes ); die "No database selected" unless @selected_dbs; @selected_dbs = map { s/(.*?)\s+\(.+\)$/$1/r } @selected_dbs; system( 'mkdir', '-p', $local_dump_dir ); # Mariadb complains about the database= line, so strip it out my ( $dump_conf_handle, $dump_conf ) = File::Temp::tempfile( 'db-dump-XXXXXX', TMPDIR => 1, UNLINK => 1 ); print $dump_conf_handle grep { !/^\s*database\s*=/ } split /^/, Util::read_file($local_db_conf); close($dump_conf_handle) or die "failed to close $dump_conf: $!"; foreach my $db (@selected_dbs) { my $dump_file = "$local_dump_dir/" . $db =~ s/:/-/gr . ".sql"; say "Dumping $db to $dump_file..."; Util::run( 'mariadb-dump', "--defaults-file=$dump_conf", "--result-file=$dump_file", $db ); } }, '32. Import Database (Mars)' => sub { # Import database dump on mars die "No dumps in $local_dump_dir" unless -d $local_dump_dir; my @dumps = grep { /\.sql$/ } Util::find_files($local_dump_dir); my @selected_dumps = TUI::select_from_list( "Select Dump to Import into Mars", 0, @dumps ); die "No dump selected" unless @selected_dumps; my $dump_file = "$local_dump_dir/$selected_dumps[0]"; # Determine database name my $db = TUI::read_string( "Database Name to Import Into", $selected_dumps[0] =~ s/\.sql$//r ); die "No database name given" unless defined $db && length $db; die "Invalid database name: $db" unless $db =~ /^[\w.:-]+$/; die "Database $db already exists on mars" if grep { $_ eq $db } Mars::db_list(); # mariadb-dump doesn't create the database, so create it here Mars::db_create($db); # point db.conf at the database Util::rewrite_file( $local_db_conf, "database=", "database=$db\n" ); say "Importing $dump_file into $db..."; Util::run( join ' ', 'mariadb', "--defaults-file=$local_db_conf", '<', Util::shell_quote($dump_file) ); }, '33. Add Query Indices (Mars)' => sub { # Add indices to accelerate queries: # - fspgroup.eq_class # - fsppilot.pilot_class # - result_GenericExperimentMessage.pilot_resulttype my @dbs = Mars::db_list(); my @dbs_with_notes; foreach my $db (@dbs) { my $info = Util::read_experiment_info( $db =~ s/smchurla_//r =~ s/:/-/gr ); push @dbs_with_notes, ( defined $info && length($info) > 0 ) ? sprintf( "%-60s (%s)", $db, $info ) : $db; } # Pick databases my @selected_dbs = TUI::select_from_list( "Select Databases to Add Indices To", 1, @dbs_with_notes ); die "No database selected" unless @selected_dbs; @selected_dbs = map { s/(.*?)\s+\(.+\)$/$1/r } @selected_dbs; my @indices = ( [ 'fspgroup', 'eq_class', 'variant_id, instr2, data_physical_address' ], [ 'fsppilot', 'pilot_class', 'variant_id, known_outcome, instr2, data_physical_address' ], [ 'result_GenericExperimentMessage', 'pilot_resulttype', 'pilot_id, resulttype' ], ); foreach my $db (@selected_dbs) { say "Adding indices to $db..."; foreach my $index (@indices) { my ( $table, $name, $columns ) = @$index; my ($exists) = Mars::db_selectrow( "SELECT COUNT(*) FROM information_schema.STATISTICS WHERE TABLE_SCHEMA = '$db' AND TABLE_NAME = '$table' AND INDEX_NAME = '$name'" ); if ($exists) { say " - $table.$name already exists, skipping"; next; } say " - Adding $table.$name ($columns)..."; Mars::db_do( "ALTER TABLE `$db`.`$table` ADD KEY `$name` ($columns)"); } } say "Added indices"; }, # '34. Repair fspgroup Write Groups (Mars)' => sub { # # # Retroactively fixes (hopefully) the missing equivalence class # # mappings (EC <-> Pilot) the BasicPruner misses (because it maps # # multiple classes to a single pilot, but uses the pilot as the # # primary key) # my @dbs = Mars::db_list(); # my @dbs_with_notes; # foreach my $db (@dbs) { # my $info = # Util::read_experiment_info( $db =~ s/smchurla_//r =~ s/:/-/gr ); # # push @dbs_with_notes, # ( defined $info && length($info) > 0 ) # ? sprintf( "%-60s (%s)", $db, $info ) # : $db; # } # # my @selected_dbs = TUI::select_from_list( "Select Databases to Repair", # 1, @dbs_with_notes ); # die "No database selected" unless @selected_dbs; # # @selected_dbs = # map { s/(.*?)\s+\(.+\)$/$1/r } @selected_dbs; # # # The PRIMARY KEY gets dropped by the repair and replaced with a KEY. # # To not run this shit on already repaired DBs, check for the PRIMARY # # index as a determinant # my $index_exists = sub { # my ($index) = @_; # my ($count) = Mars::db_selectrow( # "SELECT COUNT(*) FROM information_schema.STATISTICS # WHERE TABLE_SCHEMA = DATABASE() # AND TABLE_NAME = 'fspgroup' # AND INDEX_NAME = '$index'" # ); # return $count; # }; # # foreach my $db (@selected_dbs) { # say "Repairing $db..."; # # # Select the DB so index_exists works # Mars::db_do("use `$db`"); # # # Update the variant names, so the queries still work # my $expected_variant = $db =~ s/^smchurla_//r; # my ($variant_count) = # Mars::db_selectrow("SELECT COUNT(DISTINCT variant) FROM variant"); # my ($current_variant) = # Mars::db_selectrow("SELECT DISTINCT variant FROM variant"); # # if ( !defined $variant_count || $variant_count != 1 ) { # say " - WARNING: $variant_count distinct variants!"; # } # elsif ( $current_variant ne $expected_variant ) { # say " - Variant is '$current_variant' but queries look up" # . " '$expected_variant' (from the database name), renaming..."; # Mars::db_do("UPDATE variant SET variant = '$expected_variant'"); # } # # # Drop the primary key # if ( $index_exists->('PRIMARY') ) { # say " - Dropping PRIMARY KEY (pilot_id)..."; # Mars::db_do("ALTER TABLE fspgroup DROP PRIMARY KEY"); # } # # # Add an index for the columns we actually join on (mostly) # unless ( $index_exists->('eq_class') ) { # say " - Adding eq_class index..."; # Mars::db_do( # "ALTER TABLE fspgroup # ADD KEY eq_class (variant_id, instr2, data_physical_address)" # ); # } # # # I'm currently only using BasicPruner, but don't touch other # # pruning methods for now, for safety # my ($fspmethod_id) = # Mars::db_selectrow( # "SELECT id FROM fspmethod WHERE method = 'basic'"); # die "No 'basic' fspmethod in $db" unless defined $fspmethod_id; # # # The first row succeeded before the duplicate key error, remove it # Mars::db_do( # "DELETE g # FROM fspgroup g # JOIN fsppilot p ON p.id = g.pilot_id # WHERE p.known_outcome = 1 AND p.fspmethod_id = $fspmethod_id" # ); # # my ($expected) = # Mars::db_selectrow( # "SELECT COUNT(*) FROM trace WHERE accesstype = 'W'"); # # # Query from BasicPruner.cc, now ran against the updated DB # say " - Inserting $expected write groups..."; # Mars::db_do( # "INSERT INTO # fspgroup (variant_id, instr2, data_physical_address, bit_pos, fspmethod_id, pilot_id) # SELECT STRAIGHT_JOIN t.variant_id, t.instr2, t.data_physical_address, p.bit_pos, p.fspmethod_id, p.id # FROM fsppilot p # JOIN trace t # ON t.variant_id = p.variant_id AND p.fspmethod_id = $fspmethod_id AND p.known_outcome = 1 # WHERE t.accesstype = 'W'" # ); # # # We expect one row per write group/EC. # # Otherwise no idea what's going on :O # my ($actual) = Mars::db_selectrow( # "SELECT COUNT(*) # FROM fspgroup g # JOIN fsppilot p ON p.id = g.pilot_id # WHERE p.known_outcome = 1 AND p.fspmethod_id = $fspmethod_id" # ); # # if ( $actual == $expected ) { # say " - OK: $actual write groups match the write ECs in trace"; # } # else { # say " - WARNING: inserted $actual, expected $expected." # . " Check for duplicate known_outcome pilots:" # . " SELECT variant_id, COUNT(*) FROM fsppilot" # . " WHERE known_outcome = 1 GROUP BY variant_id;"; # } # } # # say "Queries have to be re-run."; # }, '95. Delete Builds' => 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 Builds to Delete from Mars", 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 Ghidra Projects to Delete", 1, @projects ); die "No project 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 @selected_experiments = Util::select_experiment(1); system( 'rm', '-rf', "$local_archive_dir/$_" ) for @selected_experiments; }, '99. Drop Databases (Mars)' => sub { # Drop databases on mars my @dbs = Mars::db_list(); my @dbs_with_notes; foreach my $db (@dbs) { my $info = Util::read_experiment_info( $db =~ s/smchurla_//r =~ s/:/-/gr ); push @dbs_with_notes, ( defined $info && length($info) > 0 ) ? sprintf( "%-60s (%s)", $db, $info ) : $db; } my @selected_dbs = TUI::select_from_list( "Select Databases to Drop from Mars", 1, @dbs_with_notes ); die "No database selected" unless @selected_dbs; @selected_dbs = map { s/(.*?)\s+\(.+\)$/$1/r } @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();