| #!/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) |
| # 2001 Eric Pouech |
| # |
| # ----------------------------------------------------------------------------- |
| |
| use strict; |
| |
| my $srcfile = $ARGV[0]; |
| my %tid_callstack = (); |
| my $newlineerror = 0; |
| my $indentp = 1; |
| |
| open (IN, "<$srcfile") || die "Cannot open $srcfile for reading: $!\n"; |
| LINE: |
| while (<IN>) { |
| |
| |
| if (/^([0-9a-f]+):Call ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\((.*\)) .*/ || |
| /^([0-9a-f]+):CALL ([A-Za-z0-9]+\.[A-Za-z0-9_]+: [A-Za-z0-9]+)\((.*\)) .*/) { |
| my $tid = $1; |
| my $func = $2; |
| |
| # print "have call func=$func <$_>\n"; |
| if (/ ret=(........)$/ || |
| / ret=(....:....) (ds=....)$/) { |
| my $retaddr = $1; |
| my $segreg = $2; |
| |
| $segreg = "none" unless defined $segreg; |
| |
| push @{$tid_callstack{$tid}}, [$func, $retaddr, $segreg]; |
| next; |
| } else { |
| # Assume a line got cut by a line feed in a string. |
| $_ .= scalar (<IN>); |
| if (!$newlineerror) { |
| print "Err[$tid] string probably cut by newline.\n"; |
| $newlineerror = 1; |
| } |
| # print "[$_]"; |
| redo; |
| } |
| } |
| |
| if (/^([0-9a-f]+):Ret ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\(.*\) .* ret=(........)$/ || |
| /^([0-9a-f]+):Ret ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\(.*\) .* ret=(....:....) (ds=....)$/ || |
| /^([0-9a-f]+):RET ([A-Za-z0-9]+\.[A-Za-z0-9_]+: [A-Za-z0-9]+)\(.*\) .* ret=(........)$/) { |
| my $tid = $1; |
| my $func = $2; |
| my $retaddr = $3; |
| my $segreg = $4; |
| my ($topfunc,$topaddr,$topseg); |
| |
| # print "have ret func=$func <$_>\n"; |
| if (!defined($tid_callstack{$tid})) |
| { |
| print "Err[$tid]: unknown tid\n"; |
| next; |
| } |
| |
| $segreg = "none" unless defined $segreg; |
| |
| POP: |
| while (1) { |
| if ($#{$tid_callstack{$tid}} == -1) { |
| print "Err[$tid]: Return from $func to $retaddr with empty stack.\n"; |
| next LINE; |
| } |
| |
| ($topfunc,$topaddr,$topseg) = @{pop @{$tid_callstack{$tid}}}; |
| |
| if ($topfunc ne $func) { |
| print "Err[$tid]: 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 [$tid]: ", ($indentp ? (' ' x (1 + $#{$tid_callstack{$tid}})) : ''); |
| print "$func from $retaddr with $segreg.\n"; |
| } else { |
| print "Err[$tid]: Return from $func is to $retaddr, not $topaddr.\n" |
| if !$addrok; |
| print "Err[$tid]: Return from $func with segreg $segreg, not $topseg.\n" |
| if !$segok; |
| } |
| } |
| } |
| |
| foreach my $tid (keys %tid_callstack) { |
| while ($#{$tid_callstack{$tid}} != -1) { |
| my ($topfunc,$topaddr,$topseg) = @{pop @{$tid_callstack{$tid}}}; |
| print "Err[$tid]: leftover call to $topfunc from $topaddr.\n"; |
| } |
| } |
| |
| close (IN); |