tools/examine-relay

   1 #!/usr/bin/perl -w
   2 # -----------------------------------------------------------------------------
   3 #
   4 # Relay-checker.
   5 #
   6 # This program will inspect a log file with relay information and tell you
   7 # whether calls and returns match.  If not, this suggests that the parameter
   8 # list might be incorrect.  (It could be something else also.)
   9 #
  10 # Copyright 1997-1998 Morten Welinder (terra@diku.dk)
  11 #           2001      Eric Pouech
  12 #
  13 # -----------------------------------------------------------------------------
  14
  15 use strict;
  16
  17 my $srcfile = $ARGV[0];
  18 my %tid_callstack = ();
  19 my $newlineerror = 0;
  20 my $indentp = 1;
  21
  22 open (IN, "<$srcfile") || die "Cannot open $srcfile for reading: $!\n";
  23 LINE:
  24 while (<IN>) {
  25
  26
  27     if (/^([0-9a-f]+):Call ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\((.*\)) .*/  ||
  28         /^([0-9a-f]+):CALL ([A-Za-z0-9]+\.[A-Za-z0-9_]+: [A-Za-z0-9]+)\((.*\)) .*/) {
  29         my $tid = $1;
  30         my $func = $2;
  31
  32 #       print "have call func=$func <$_>\n";
  33         if (/ ret=(........)$/ ||
  34             / ret=(....:....) (ds=....)$/) {
  35             my $retaddr = $1;
  36             my $segreg = $2;
  37
  38             $segreg = "none" unless defined $segreg;
  39
  40             push @{$tid_callstack{$tid}}, [$func, $retaddr, $segreg];
  41             next;
  42         } else {
  43             # Assume a line got cut by a line feed in a string.
  44             $_ .= scalar (<IN>);
  45             if (!$newlineerror) {
  46                 print "Err[$tid] string probably cut by newline.\n";
  47                 $newlineerror = 1;
  48             }
  49             # print "[$_]";
  50             redo;
  51         }
  52     }
  53
  54     if (/^([0-9a-f]+):Ret  ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\(.*\) .* ret=(........)$/ ||
  55         /^([0-9a-f]+):Ret  ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\(.*\) .* ret=(....:....) (ds=....)$/ ||
  56         /^([0-9a-f]+):RET  ([A-Za-z0-9]+\.[A-Za-z0-9_]+: [A-Za-z0-9]+)\(.*\) .* ret=(........)$/) {
  57         my $tid = $1;
  58         my $func = $2;
  59         my $retaddr = $3;
  60         my $segreg = $4;
  61         my ($topfunc,$topaddr,$topseg);
  62
  63 #       print "have ret func=$func <$_>\n";
  64         if (!defined($tid_callstack{$tid}))
  65         {
  66             print "Err[$tid]: unknown tid\n";
  67             next;
  68         }
  69
  70         $segreg = "none" unless defined $segreg;
  71
  72       POP:
  73         while (1) {
  74             if ($#{$tid_callstack{$tid}} == -1) {
  75                 print "Err[$tid]: Return from $func to $retaddr with empty stack.\n";
  76                 next LINE;
  77             }
  78
  79             ($topfunc,$topaddr,$topseg) = @{pop @{$tid_callstack{$tid}}};
  80
  81             if ($topfunc ne $func) {
  82                 print "Err[$tid]: Return from $topfunc, but call from $func.\n";
  83                 next POP;
  84             }
  85             last POP;
  86         }
  87
  88         my $addrok = ($topaddr eq $retaddr);
  89         my $segok = ($topseg eq $segreg);
  90         if ($addrok && $segok) {
  91             print "Ok [$tid]: ", ($indentp ? (' ' x (1 + $#{$tid_callstack{$tid}})) : '');
  92             print "$func from $retaddr with $segreg.\n";
  93         } else {
  94             print "Err[$tid]: Return from $func is to $retaddr, not $topaddr.\n"
  95                 if !$addrok;
  96             print "Err[$tid]: Return from $func with segreg $segreg, not $topseg.\n"
  97                 if !$segok;
  98         }
  99     }
 100 }
 101
 102 foreach my $tid (keys %tid_callstack) {
 103     while ($#{$tid_callstack{$tid}} != -1) {
 104         my ($topfunc,$topaddr,$topseg) = @{pop @{$tid_callstack{$tid}}};
 105         print "Err[$tid]: leftover call to $topfunc from $topaddr.\n";
 106     }
 107 }
 108
 109 close (IN);