failnix/scripts/Util.pm

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 if defined $info;
    close($fhandle);

    return defined $info ? $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 && length($info) > 0 )
          ? 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;