Sweden-Number/tools/examine-relay

92 lines
2.4 KiB
Perl
Executable File

#!/usr/bin/perl -w
# -----------------------------------------------------------------------------
#
# Relay-checker.
#
# This program will inspect a log file with relay information and tell you
# whether calls and returns match. If not, this suggests that the parameter
# list might be incorrect. (It could be something else also.)
#
# Copyright 1997-1998 Morten Welinder (terra@diku.dk)
#
# -----------------------------------------------------------------------------
my $srcfile = $ARGV[0];
my @callstack = ();
my $newlineerror = 0;
my $indentp = 1;
open (IN, "<$srcfile") || die "Cannot open $srcfile for reading: $!\n";
LINE:
while (<IN>) {
if (/^Call ([A-Za-z0-9]+\.\d+): .*\)/) {
my $func = $1;
if (/ ret=(........)$/ ||
/ ret=(....:....) (ds=....)$/ ||
/ ret=(........) (fs=....)$/) {
my $retaddr = $1;
my $segreg = $2;
$segreg = "none" unless defined $segreg;
push @callstack, [$func,$retaddr, $segreg];
next;
} else {
# Assume a line got cut by a line feed in a string.
$_ .= scalar (<IN>);
if (!$newlineerror) {
print "Error: string probably cut by newline.\n";
$newlineerror = 1;
}
# print "[$_]";
redo;
}
}
if (/^Ret ([A-Za-z0-9]+\.\d+): .* ret=(........)$/ ||
/^Ret ([A-Za-z0-9]+\.\d+): .* ret=(....:....) (ds=....)$/ ||
/^Ret ([A-Za-z0-9]+\.\d+): .* ret=(........) (fs=....)$/) {
my $func = $1;
my $retaddr = $2;
my $segreg = $3;
my ($topfunc,$topaddr,$topseg);
$segreg = "none" unless defined $segreg;
POP:
while (1) {
if ($#callstack == -1) {
print "Error: Return from $func to $retaddr with empty stack.\n";
next LINE;
}
($topfunc,$topaddr,$topseg) = @{pop @callstack};
if ($topfunc ne $func) {
print "Error: Return from $topfunc, but call from $func.\n";
next POP
}
last POP;
}
my $addrok = ($topaddr eq $retaddr);
my $segok = ($topseg eq $segreg);
if ($addrok && $segok) {
print "OK: ", ($indentp ? (' ' x (1 + $#callstack)) : '');
print "$func from $retaddr with $segreg.\n";
} else {
print "Error: Return from $func is to $retaddr, not $topaddr.\n"
if !$addrok;
print "Error: Return from $func with segreg $segreg, not $topseg.\n"
if !$segok;
}
}
}
while ($#callstack != -1) {
my ($topfunc,$topaddr) = @{pop @callstack};
print "Error: leftover call to $topfunc from $topaddr.\n";
}
close (IN);