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: $!"; local $/; 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 Experiment", $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;