267 lines
6.7 KiB
Perl
267 lines
6.7 KiB
Perl
package Util;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use diagnostics;
|
|
|
|
use DateTime;
|
|
|
|
use feature 'say';
|
|
|
|
my $local_root = '/home/christoph/Notes/TU/MastersThesis/FailNix';
|
|
my $local_archive_dir = "$local_root/injections";
|
|
|
|
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" );
|
|
|
|
sleep(1);
|
|
}
|
|
|
|
sub notify_file {
|
|
my ($file) = @_;
|
|
|
|
system(
|
|
'curl', '-H', "Authorization: Bearer $ntfy_token",
|
|
'-T', $file, '-H', "Filename: $file",
|
|
"$ntfy_url/$ntfy_topic"
|
|
);
|
|
|
|
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 ) = @_;
|
|
|
|
open( my $readhandle, '<', $file ) or die "failed to open $file: $!";
|
|
my @lines;
|
|
my $found = 0;
|
|
while ( my $line = <$readhandle> ) {
|
|
if ( index( $line, $matches ) != -1 ) {
|
|
$line = $replacement;
|
|
$found = 1;
|
|
}
|
|
push @lines, $line;
|
|
}
|
|
close($readhandle) or die "failed to close $file: $!";
|
|
|
|
die "no line containing $matches found in $file" unless $found;
|
|
|
|
open( my $writehandle, '>', $file ) or die "failed to open $file: $!";
|
|
print $writehandle @lines or die "failed to write $file: $!";
|
|
close($writehandle) or die "failed to close $file: $!";
|
|
|
|
say "Updated $file with $replacement";
|
|
}
|
|
|
|
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;
|
|
}
|
|
|
|
sub find_files {
|
|
my ($dir) = @_;
|
|
|
|
opendir( my $dhandle, $dir ) or die "opendir($dir): $!";
|
|
my @files = sort grep { -f "$dir/$_" } readdir($dhandle);
|
|
closedir($dhandle);
|
|
|
|
return @files;
|
|
}
|
|
|
|
sub find_subdirs {
|
|
my ($dir) = @_;
|
|
|
|
opendir( my $dhandle, $dir ) or die "opendir($dir): $!";
|
|
my @subdirs =
|
|
sort grep { $_ ne '.' && $_ ne '..' && -d "$dir/$_" } readdir($dhandle);
|
|
closedir($dhandle);
|
|
|
|
return @subdirs;
|
|
}
|
|
|
|
sub execute_query {
|
|
my ( $experiment, $queryname, $db_conf, $builds_dir, $do_notify_file ) = @_;
|
|
|
|
my $module = "Queries::$queryname";
|
|
my $file = "$module.pm";
|
|
$file =~ s/::/\//g;
|
|
|
|
require $file;
|
|
|
|
my $query = $module->can('query') or die "$module can't query()";
|
|
my $args = $module->can('args') or die "$module can't args()";
|
|
my $filename = $module->can('filename') or die "$module can't filanem()";
|
|
my $postprocess = $module->can('postprocess')
|
|
or die "$module can't postprocess()";
|
|
|
|
my $querystring = $query->($experiment);
|
|
my $argsstring = $args->();
|
|
my $filenamestring = $filename->();
|
|
|
|
# TODO: Pass the values instead of rewriting db.conf.
|
|
# Can also use DBI's database handle directly.
|
|
my $result =
|
|
qx{mariadb --defaults-file=$db_conf $argsstring -e "$querystring"};
|
|
die "Query failed: $?" if $? != 0;
|
|
|
|
$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;
|
|
close($results_handle) or die "failed to close file: $!";
|
|
|
|
if ( defined $do_notify_file and $do_notify_file == 1 ) {
|
|
notify_file("$builds_dir/$experiment/$filenamestring");
|
|
}
|
|
|
|
return $result;
|
|
}
|
|
|
|
sub format_number_sep {
|
|
my ($number) = @_;
|
|
1 while $number =~ s/^(-?\d+)(\d{3})/$1.$2/;
|
|
return $number;
|
|
}
|
|
|
|
sub elf_read_sections {
|
|
my ($elffile) = @_;
|
|
|
|
my $readelf_out = qx{readelf -S $elffile};
|
|
my @lines = split "\n", $readelf_out;
|
|
|
|
my @sections;
|
|
foreach my $line (@lines) {
|
|
|
|
# [ 1] .text PROGBITS 00100000 001000 0000f0 00 AX 0 0 4
|
|
next
|
|
unless $line =~
|
|
/^\s*\[\s*\d+\]\s+(\..+?)\s+([A-Z]+)\s+([0-9a-f]+)\s+([0-9a-f]+)\s+([0-9a-f]+)\s+.*$/;
|
|
|
|
push @sections, {
|
|
name => $1,
|
|
type => $2,
|
|
address => $3, # Memory location
|
|
offset => $4, # File location
|
|
size => $5,
|
|
};
|
|
}
|
|
|
|
return @sections;
|
|
}
|
|
|
|
sub get_section_name {
|
|
my ( $address, @sections ) = @_;
|
|
|
|
my $name;
|
|
my $last_address = 0;
|
|
foreach my $section (@sections) {
|
|
my $cur_address = hex( $section->{address} );
|
|
if ( hex($address) >= $cur_address && $cur_address > $last_address ) {
|
|
$name = $section->{name};
|
|
$last_address = $cur_address;
|
|
}
|
|
}
|
|
|
|
return $name;
|
|
}
|
|
|
|
sub read_experiment_info {
|
|
my ($exp) = @_;
|
|
|
|
return unless ( -f "$local_archive_dir/$exp/0.info" );
|
|
|
|
open( my $fhandle, '<', "$local_archive_dir/$exp/0.info" )
|
|
or die "Failed to open 0.info: $!";
|
|
my $info = <$fhandle>;
|
|
chomp $info;
|
|
close($fhandle);
|
|
|
|
return $info;
|
|
}
|
|
|
|
sub read_marker_info {
|
|
my ( $experiment, $benchmark, $address ) = @_;
|
|
|
|
return ""
|
|
unless (
|
|
-f "$local_archive_dir/$experiment/markers/$benchmark-$address.info" );
|
|
|
|
open( my $fhandle, '<',
|
|
"$local_archive_dir/$experiment/markers/$benchmark-$address.info" )
|
|
or die "Failed to open $benchmark-$address.info: $!";
|
|
my $info = <$fhandle>;
|
|
chomp $info;
|
|
close($fhandle);
|
|
|
|
return $info;
|
|
}
|
|
|
|
sub overwrite_marker_info {
|
|
my ( $experiment, $benchmark, $address, $info ) = @_;
|
|
|
|
system( 'mkdir', '-p', "$local_archive_dir/$experiment/markers" );
|
|
|
|
open( my $fhandle, '>',
|
|
"$local_archive_dir/$experiment/markers/$benchmark-$address.info" )
|
|
or die "Failed to open $benchmark-$address.info: $!";
|
|
print $fhandle $info;
|
|
close($fhandle);
|
|
}
|
|
|
|
sub delete_marker_info {
|
|
my ( $experiment, $benchmark, $address ) = @_;
|
|
|
|
system( 'rm',
|
|
"$local_archive_dir/$experiment/markers/$benchmark-$address.info" );
|
|
}
|
|
|
|
sub select_experiment {
|
|
my ($multi) = @_;
|
|
|
|
my @experiments = find_subdirs($local_archive_dir);
|
|
|
|
my @exp_with_notes;
|
|
foreach my $exp (@experiments) {
|
|
my $info = read_experiment_info($exp);
|
|
|
|
push @exp_with_notes,
|
|
defined $info ? sprintf( "%-50s (Note: %s)", $exp, $info ) : $exp;
|
|
}
|
|
|
|
my @selected_experiments =
|
|
TUI::select_from_list( "Select Archived Experiment to Open",
|
|
$multi, @exp_with_notes );
|
|
die "No experiment selected" unless @selected_experiments;
|
|
|
|
map { s/(.*?)\s+\(Note:.+\)$/$1/ } @selected_experiments;
|
|
|
|
return $multi == 1 ? @selected_experiments : $selected_experiments[0];
|
|
}
|
|
|
|
1;
|