errors-migrate.pl 3.26 KB
Newer Older
1
#!/usr/bin/perl -w
Mike Hibler's avatar
Mike Hibler committed
2 3
#
# Copyright (c) 2003-2006 University of Utah and the Flux Group.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
Mike Hibler's avatar
Mike Hibler committed
23
#
24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123

use strict;

use DBI;

my $database = 'tbdb';
my $username = 'root';
my $passwd = '';

my $dbh = DBI->connect("DBI:mysql:database=$database", $username, $passwd);

my $sth = $dbh->prepare("select * from scripts");
$sth->execute;
my %script_map;
my @script_map;
while ((my $ref = $sth->fetchrow_arrayref)) {
   $script_map{$ref->[1]} = $ref->[0];
   $script_map[$ref->[0]] = $ref->[1];
}
$script_map{unknown} = 0;
$script_map[0] = 'unknown';

$sth = $dbh->prepare("select stamp,session,exptidx,mesg from log where type = 'thecause' order by session");
$sth->execute;

my $sth2 = $dbh->prepare("select script_name,cause,type from log natural join scripts where session = ? and relevant order by seq desc");

my $ins = $dbh->prepare("insert into errors (session,stamp,exptidx,script,cause,confidence,mesg) values (?,?,?,?,?,?,?)");

my $ready = 0;

while ((my $ref = $sth->fetchrow_arrayref)) {
  my ($stamp,$session,$exptidx,$mesg) = @$ref;
  my $script = "unknown";
  my $cause = "unknown";
  my $confidence = 0.0;
  local $_ = $mesg;
  if (/^\d+: ([^:]+)/) {
    $script = $1;
  } else {
    if (s/\nCause: (\S+)\nConfidence: (\S+)$//) {
      $cause = $1;
      $confidence = $2;
    }
    s/^  //gm;
    $mesg = $_;
    ($_) = split /\n\s*\n/;
    if (/\(([^\)]+)\)$/ && defined $script_map{$1}) {
      $script = $1;
    } else {
      warn "Unable to find script in: $_\n" unless /No clue as to what went wrong/;
    }
    $sth2->execute($session);
    my @rel;
    while ((my $r = $sth2->fetchrow_hashref)) {
      push @rel, {%$r};
    }

    if (@rel) {

      warn "Script name mismatch: $rel[0]{script_name} ne $script in: $_\n" 
	if $rel[0]{script_name} ne $script;

      $script = $rel[0]{script_name};

      my $conf = 0.5;
      if ($script =~ /^(assign|parse)/) {
	$conf = 0.9;
      } elsif ($script =~ /^(os_setup)/) {
	$conf = 0.2;
      }

      my $t = '';
      my $c = '';
      foreach (@rel) {
	$ready = 1 if $_->{cause} && $_->{cause} ne 'unknown';
	if (!$c && $_->{cause}) {
	  $c = $_->{cause};
	  $t = $_->{type};
	} elsif ($_->{cause} &&
		 $_->{type} eq $t && $_->{cause} ne $c) {
	  $c = 'unknown';
	}
      }
      $c = 'unknown' unless $c;

      if ($cause eq 'unknown' && $ready) {
	$cause = $c;
	$confidence = $conf;
      } elsif ($cause ne 'unknown') {
	warn "Cause mismatch" unless $cause eq $c;
	warn "Confidence mismatched" unless $conf == $confidence;
      }
    }
  }

  $ins->execute($session,$stamp,$exptidx,$script_map{$script},$cause,$confidence,$mesg);
}