#!/usr/bin/env perl use strict; use warnings; use diagnostics; use feature 'say'; my $remote_root = '/home/lab/smchurla/Documents/failnix'; my $remote_db_conf = "$remote_root/db.conf"; my $remote_builds_dir = "$remote_root/builds"; my $remote_runner = "$remote_root/scripts/runner.pl"; my $db_user = "smchurla"; my $db_prefix = "$db_user"; my $fail_server_port = '22941'; my $resultbrowser_port = '22941'; my $fail_bin = "$remote_root/fail/bin"; my $fail_share = "$remote_root/fail/share"; my $bochs_runner = "$fail_bin/bochs-experiment-runner.py"; my $fail_trace = "$fail_bin/fail-x86-tracing"; my $fail_dump = "$fail_bin/dump-trace"; my $fail_import = "$fail_bin/import-trace"; my $fail_prune = "$fail_bin/prune-trace"; my $fail_server = "$fail_bin/generic-experiment-server"; my $fail_inject = "$fail_bin/generic-experiment-client"; my $result_browser = "$fail_bin/resultbrowser.py"; my $ntfy_url = "https://ntfy.vps.chriphost.de"; my $ntfy_token = "tk_rx8fd6hojuz4ekcb72j7juugkbmga"; # May be public my $ntfy_topic = "fail-alerts"; sub notify { my ($msg) = @_; system( "curl", "-H", "Authorization: Bearer $ntfy_token", "-d", $msg, "$ntfy_url/$ntfy_topic" ); } sub update_db_config { my ($experiment) = @_; open( my $readhandle, '<', $remote_db_conf ) or die "failed to open db.conf: $!"; my @lines; my $found = 0; while ( my $line = <$readhandle> ) { if ( rindex( $line, "database=", 0 ) == 0 ) { $line = "database=${db_prefix}_$experiment\n"; $found = 1; } push @lines, $line; } close($readhandle) or die "failed to close db.conf: $!"; say "Sanity check:"; say @lines; die "no database= line found in $remote_db_conf for some reason" unless $found; open( my $writehandle, '>', $remote_db_conf ) or die "failed to open db.conf: $!"; print( $writehandle, @lines ) or die "failed to write db.conf: $!"; close($writehandle) or die "failed to close db.conf: $!"; say "Updated db.conf for database $db_prefix\_$experiment"; } sub cpu_count { open( my $handle, "/proc/cpuinfo" ) or die "Can't open cpuinfo: $!\n"; my $count = scalar( map /^processor/, <$handle> ); close $handle; return $count; } # Find new experiments opendir( my $dhandle, $remote_builds_dir ) or die "opendir($remote_builds_dir): $!"; my @experiments = grep { $_ ne '.' && $_ ne '..' && -d "$remote_builds_dir/$_" } readdir($dhandle); closedir($dhandle); sub trace { my ($experiment) = @_; notify("Tracing $experiment..."); system( $bochs_runner, "-V $fail_share/vgabios.bin", "-b $fail_share/BIOS-bochs-latest", "-1", "-f $fail_trace", "-e $remote_builds_dir/$experiment/system.elf", "-i $remote_builds_dir/$experiment/system.iso", "--", "-Wf,--start-symbol=fail_start_trace", "-Wf,--save-symbol=fail_start_trace", "-Wf,--end-symbol=fail_stop_trace", "-Wf,--state-file=$remote_builds_dir/$experiment/state", "-Wf,--trace-file=$remote_builds_dir/$experiment/trace.pb", "-Wf,--elf-file=$remote_builds_dir/$experiment/system.elf" ); notify("Tracing $experiment complete."); } sub import_trace { my ($experiment) = @_; notify("Importing $experiment trace..."); system( "$fail_import", "--database-option-file $remote_db_conf", "-t $remote_builds_dir/$experiment/trace.pb", "-i MemoryImporter", "-e $remote_builds_dir/$experiment/system.elf", "-v $experiment", "-b mem" ); system( "$fail_import", "--database-option-file $remote_db_conf", "-t $remote_builds_dir/$experiment/trace.pb", "-i RegisterImporter", "-e $remote_builds_dir/$experiment/system.elf", "-v $experiment", "-b regs --flags" ); system( "$fail_import", "--database-option-file $remote_db_conf", "-t $remote_builds_dir/$experiment/trace.pb", "-i RegisterImporter", "-e $remote_builds_dir/$experiment/system.elf", "-v $experiment", "-b ip --no-gp --ip" ); system( "$fail_import", "--database-option-file $remote_db_conf", "-t $remote_builds_dir/$experiment/trace.pb", "-i ElfImporter", "--objdump objdump -e $remote_builds_dir/$experiment/system.elf", "-v $experiment", "-b ip" ); system( "$fail_import", "--database-option-file $remote_db_conf", "-t $remote_builds_dir/$experiment/trace.pb", "-i ElfImporter", "--objdump objdump -e $remote_builds_dir/$experiment/system.elf", "-v $experiment", "-b mem" ); system( "$fail_import", "--database-option-file $remote_db_conf", "-t $remote_builds_dir/$experiment/trace.pb", "-i ElfImporter", "--objdump objdump -e $remote_builds_dir/$experiment/system.elf", "-v $experiment", "-b regs" ); system( "$fail_prune", "--database-option-file $remote_db_conf", "-v $experiment", "-b %%", "--overwrite" ); notify("Importing $experiment trace complete."); } sub inject { my ($experiment) = @_; notify("Injecting $experiment..."); my $pid = fork(); die "fork failed: $!" unless defined $pid; if ( $pid == 0 ) { # child -> server exec( $fail_server, "--port $fail_server_port", "--database-option-file $remote_db_conf", "-v $experiment", "-b %", "--inject-single-bit", "--inject-registers" ) or die "exec server failed: $!"; } # parent -> client my $count = cpu_count(); system( "nice", $bochs_runner, "-V $fail_share/vgabios.bin", "-b $fail_share/BIOS-bochs-latest", "-f $fail_inject", "-e $remote_builds_dir/$experiment/system.elf", "-i $remote_builds_dir/$experiment/system.iso", "-j $count", "--", "-Wf,--server-port=$fail_server_port", "-Wf,--state-dir=$remote_builds_dir/$experiment/state", "-Wf,--trap", "-Wf,--catch-outerspace", # "-Wf,--catch-write-textsegment", "-Wf,--timeout=500000", "-Wf,--ok-marker=fail_marker_positive", "-Wf,--fail-marker=fail_marker_negative", "-Wf,--detected-marker=fail_marker_detected", "> /dev/null" ) or die "client failed: $?"; kill 'TERM', $pid; waitpid( $pid, 0 ); notify("Injecting $experiment complete."); } # TODO: Add a function that accepts query + output file args sub results { my ($experiment) = @_; my $results_overview_query = "SELECT variant, benchmark, resulttype, sum(t.time2 - t.time1 + 1) as faults FROM variant v JOIN trace t ON v.id = t.variant_id JOIN fspgroup g ON g.variant_id = t.variant_id AND g.instr2 = t.instr2 AND g.data_address = t.data_address JOIN result_GenericExperimentMessage r ON r.pilot_id = g.pilot_id JOIN fsppilot p ON r.pilot_id = p.id WHERE v.variant = '$experiment' GROUP BY v.id, resulttype ORDER BY variant, benchmark, resulttype;"; my $results_overview = qx{ mariadb --defaults-file=$remote_db_conf -t -e "$results_overview_query" }; die "Query failed: $?" if $? != 0; open( my $results_overview_handle, '>', "$remote_builds_dir/$experiment/results.txt" ) or die "failed to open file: $!"; print( $results_overview_handle, $results_overview ); close($results_overview_handle) or die "failed to close file: $!"; my $fail_markers_query = "SELECT CONCAT('0x', HEX(p.injection_instr_absolute)) AS fault_address, SUM(t.time2 - t.time1 + 1) AS total_fail_markers FROM trace t JOIN variant v ON v.id = t.variant_id JOIN fspgroup g ON g.variant_id = t.variant_id AND g.instr2 = t.instr2 AND g.data_address = t.data_address JOIN result_GenericExperimentMessage r ON r.pilot_id = g.pilot_id JOIN fsppilot p ON p.id = r.pilot_id WHERE v.variant = '$experiment' AND r.resulttype = 'FAIL_MARKER' GROUP BY p.injection_instr_absolute ORDER BY SUM(t.time2 - t.time1 + 1) DESC;"; my $fail_markers = qx{ mariadb --defaults-file=$remote_db_conf --batch --raw -e "$fail_markers_query" }; die "Query failed: $?" if $? != 0; $fail_markers =~ s/\t/,/g; open( my $fail_markers_handle, '>', "$remote_builds_dir/$experiment/markers.csv" ) or die "failed to open file: $!"; print( $fail_markers_handle, $fail_markers ); close($fail_markers_handle) or die "failed to close file: $!"; } # Run experiments for my $experiment (@experiments) { update_db_config($experiment); trace($experiment); import_trace($experiment); inject($experiment); results($experiment); }