| #!/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); |