CrashTest.pl
author Vincent Tondellier <tonton+hg@team1664.org>
Thu, 03 May 2012 13:17:05 +0200
changeset 6 8dfc7e5dbdc7
parent 3 2ff78fe4abda
child 11 0bef3b8087c1
permissions -rwxr-xr-x
Fix compatibility with perl < 5.11

#!/usr/bin/env perl

use Mojolicious::Lite;
use UUID;
use Mojo::JSON;
use Mojo::UserAgent;

my @valid_params = qw/Add-ons Distributor ProductName ReleaseChannel StartupTime UserID Version BuildID CrashTime Comments/;
my $config = plugin 'Config';
my $data_path = $config->{DataDir};


helper scm_file_link => sub {
    my ($self, $file, $line) = @_;

    return "" unless(defined($file));

    if($file =~ qr{([a-z]+):([a-z/.]+):(.+):(\d+)})
    {
        my ($scm, $repo, $scmpath, $rev) = ($1, $2, $3, $4);
        my $filename = File::Spec->splitpath($scmpath);
        my $scmrepo = "$scm:$repo";
        if(exists($config->{ScmLinks}->{$scmrepo})) {
            return Mojo::ByteStream->new($self->link_to("$filename:$line" =>
                    $self->render(inline => $config->{ScmLinks}->{$scmrepo}, repo => $repo, scmpath => $scmpath, rev => $rev, line => $line, partial => 1)
                ));
        }
        #return $file;
    }
    my $filebase = (File::Spec->splitpath($file))[-1];
    if(defined($line) && $line ne "") {
        return "$filebase:$line";
    }
    return $filebase;
};

helper shorten_signature => sub {
    my ($self, $signature) = @_;

    return "" if(!defined($signature) || $signature eq "");

    my $short_signature = $signature;
    if($signature =~ qr{([^<]+)<.+>::([^()]+)\(.*\)(.*)}) {
        # c++ with template
        $short_signature = "$1<>::$2()$3";
    } elsif($signature =~ qr{([^()]+)\(.*\)(.*)}) {
        # c/c++
        $short_signature = "$1()$2";
    }
    return Mojo::ByteStream->new($self->t(span => (title => $signature, class => "shortened-signature") => $short_signature));
};

# Upload form in DATA section
get '/' => sub {
    my $self = shift;

    my @files;
    opendir my ($dh), $data_path or die $!;
    my @allfiles = readdir $dh;
    foreach(@allfiles)
    {
        if($_ =~ /(.*)\.json$/)
        {
            my $filename = File::Spec->catfile($data_path, $_);
            push @files, {
                file => $filename,
                uuid => $1,
                signature => $1,
                product => "",
                date => (stat $filename)[9],
            };
        }
    }
    closedir $dh;

    my @sorted_files = ( sort { $b->{date} <=> $a->{date} } @files );
    @sorted_files = @sorted_files[0..19] if scalar(@sorted_files) > 20;

    $self->stash(files => \@sorted_files);

    $self->render('index');
} => 'index';

get '/report/:uuid' => [ uuid => qr/[0-9a-fA-F-]+/ ] => sub {
    my $self = shift;

    open JSON, '<', File::Spec->catfile($data_path, $self->param('uuid') . '.json') or die $!;
    my @json_content_lines = <JSON>;
    my $json_content = join('', @json_content_lines);
    close JSON;

    my $json = Mojo::JSON->new;
    my $processed_data = $json->decode($json_content);

    $self->stash(processed_data => $processed_data);

    $self->render('report/crash');
} => 'report';

post '/submit' => sub {
    my $self = shift;

    # save the dump in a file
    my $file = $self->req->upload('upload_file_minidump');
    my ($uuid, $uuidstr);
    UUID::generate($uuid);
    UUID::unparse($uuid, $uuidstr);
    my $dmp_file = File::Spec->catfile($data_path, "$uuidstr.dmp");
    $file->move_to($dmp_file);

    # Create json for the params
    my %paramshash = map { $_ => $self->req->param($_) } $self->req->param;

    my $out = qx($config->{MinidumpStackwalkJSON} "$dmp_file" $config->{SymbolsPath} 2>/dev/null) or die $!;

    my $json = Mojo::JSON->new;
    my $pjson = $json->decode($out);
    $pjson->{client_info} = \%paramshash;

    my $j = $json->encode($pjson);
    open JSON, '>', File::Spec->catfile($data_path, "$uuidstr.json") or die $!;
    print JSON $j;
    close JSON;

    # reply
    $self->render_text($pjson->{status});
};

app->secret('My secret passphrase here');
app->start;