decode-trace IPv6 support + some minor fixes in it
* IPv6 extensions to patterns * use full GUID prefix for Cyclone * pattern fixes to deal with small changes in the formatting of QoS * suppressinof local built-in topic publications * asymmetrical disconnect detection improvements (better chance of detecting it, plus better suppression of spurious notifications) Signed-off-by: Erik Boasson <eb@ilities.com>
This commit is contained in:
parent
e412f6fab2
commit
9c272c98b8
1 changed files with 74 additions and 49 deletions
|
@ -72,7 +72,7 @@ my $last_infots;
|
||||||
my %spdp_info;
|
my %spdp_info;
|
||||||
my $hexmode = 1;
|
my $hexmode = 1;
|
||||||
my $sysid_hex;
|
my $sysid_hex;
|
||||||
my $proto = '(?:udp4?|tcp4?)\/';
|
my $proto_ip = "(?:(?:udp[46]?|tcp[46]?)\/)?(?:[0-9.]+|\[[0-9a-fA-F:]+\])";
|
||||||
my %tstamps;
|
my %tstamps;
|
||||||
my %topic_qos;
|
my %topic_qos;
|
||||||
my $recv_packet = 0;
|
my $recv_packet = 0;
|
||||||
|
@ -275,12 +275,14 @@ while(<>) {
|
||||||
check_disccomplete("B", $1);
|
check_disccomplete("B", $1);
|
||||||
}
|
}
|
||||||
|
|
||||||
# Special handling of INFOTS & SPDP for extracting start times of remote nodes and making an
|
|
||||||
# informed guess as to whether the remote node learned of our existence because we sent a
|
|
||||||
# multicast or a unicast
|
|
||||||
if (/recv(?:UC|MC)?: INFOTS\((\d+)\.(\d+)\)/) {
|
if (/recv(?:UC|MC)?: INFOTS\((\d+)\.(\d+)\)/) {
|
||||||
|
# Special handling of INFOTS for guessing at source time stamps (in particular also
|
||||||
|
# for guessing at start times of other nodes
|
||||||
$last_infots = ($1 - $t0sec) + ($2/1e3 - $t0usec) / 1e6;
|
$last_infots = ($1 - $t0sec) + ($2/1e3 - $t0usec) / 1e6;
|
||||||
} elsif ($hexmode ? m/recv: DATA\(((?:[0-9a-f]+:){3}100c2) -> ($guidre)/ : m/recv: DATA\(((?:[0-9a-f]+:){3}65730) -> ($guidre)/) {
|
} elsif ($hexmode ? m/recv(?:UC|MC)?: DATA\(((?:[0-9a-f]+:){3}100c2) -> ($guidre)/ : m/recv(?:UC|MC)?: DATA\(((?:[0-9a-f]+:){3}65730) -> ($guidre)/) {
|
||||||
|
# SPDP for extracting start times of remote nodes and making an informed guess as to
|
||||||
|
# whether the remote node learned of our existence because we sent a multicast or a
|
||||||
|
# unicast
|
||||||
my $src = $1; my $dst = $2;
|
my $src = $1; my $dst = $2;
|
||||||
(my $ppguid = hexify($src)) =~ s/:(100c2|65730)$/:1c1/;
|
(my $ppguid = hexify($src)) =~ s/:(100c2|65730)$/:1c1/;
|
||||||
my $directed = ($dst !~ /^0:0:0:/);
|
my $directed = ($dst !~ /^0:0:0:/);
|
||||||
|
@ -290,23 +292,39 @@ while(<>) {
|
||||||
# relatively long after discovery. "Relatively long" being a pretty difficult
|
# relatively long after discovery. "Relatively long" being a pretty difficult
|
||||||
# concept to work with, we use the "discovery complete" flag to see if it is a
|
# concept to work with, we use the "discovery complete" flag to see if it is a
|
||||||
# likely asymmetrical disconnect
|
# likely asymmetrical disconnect
|
||||||
if ($proxypp{$ppguid}->{disccompleteflag}) {
|
if ($proxypp{$ppguid}->{disccompleteflag} && $ts > $proxypp{$ppguid}->{tasymdisc} + 5) {
|
||||||
my $sysid = $proxypp{$ppguid}->{sysid};
|
my $sysid = $proxypp{$ppguid}->{sysid};
|
||||||
my $sx = decimal_sysid($sysid);
|
my $sx = decimal_sysid($sysid);
|
||||||
printf "%9.3f %35s $topfmt ASYM %s (%s; %s; %s) likely asymmetrical disconnect\n", $ts, $sysid, "", $sysid{$sysid}->{ip}, $sx, $sysid{$sysid}->{name}, vendorstr($spdp_info{$ppguid}->{vendor});
|
printf "%9.3f %35s $topfmt ASYM %s (%s; %s; %s) likely asymmetrical disconnect\n", $ts, $sysid, "", $sysid{$sysid}->{ip}, $sx, $sysid{$sysid}->{name}, vendorstr($spdp_info{$ppguid}->{vendor});
|
||||||
|
$proxypp{$ppguid}->{tasymdisc} = $ts;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
} elsif (/: ACKNACK\(#\d+:1\/0:\s+(?:$leasere)?([0-9a-f]+(?::[0-9a-f]+){2}:([34])c7) -\>/) {
|
||||||
|
# An ACKNACK that acks nothing, nacks nothing and requests a response (no "F" flag
|
||||||
|
# present) is a tell-tale sign of a pre-emptive ACKNACK. Receipt of one of those
|
||||||
|
# after having received a normal one is indicative of an asymmetrical disconnect.
|
||||||
|
# Detecting when all is well again is too hard. Being lazy, we simply gate it with
|
||||||
|
# the "discovery complete" flag and suppress it within a window of 1s.
|
||||||
|
my $src = $1; my $src_id = $2;
|
||||||
|
(my $ppguid = hexify($src)) =~ s/:[0-9a-f]+$/:1c1/;
|
||||||
|
if (exists $proxypp{$ppguid} && $proxypp{$ppguid}->{disccompleteflag} && $ts > $proxypp{$ppguid}->{tasymdisc} + 1) {
|
||||||
|
my $sysid = $proxypp{$ppguid}->{sysid};
|
||||||
|
my $sx = decimal_sysid($sysid);
|
||||||
|
printf "%9.3f %35s $topfmt ASYM %s (%s; %s; %s) likely asymmetrical disconnect\n", $ts, $sysid, "", $sysid{$sysid}->{ip}, $sx, $sysid{$sysid}->{name}, vendorstr($spdp_info{$ppguid}->{vendor});
|
||||||
|
$proxypp{$ppguid}->{tasymdisc} = $ts;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
if (/: ownip: (?:$proto)?([0-9.]+)/o) {
|
if (/: ownip: ($proto_ip)/o) {
|
||||||
$ownip = $1;
|
$ownip = $1;
|
||||||
|
$ownip =~ s/^(udp|tcp)[46]?\///;
|
||||||
} elsif (/: PARTICIPANT ($guidre) QOS=\{/o) {
|
} elsif (/: PARTICIPANT ($guidre) QOS=\{/o) {
|
||||||
my $guid = hexify($1);
|
my $guid = hexify($1);
|
||||||
(my $gid = $guid) =~ s/:[^:]+$//;
|
(my $gid = $guid) =~ s/:[^:]+$//;
|
||||||
my $userdata = $_;
|
my $userdata = $_;
|
||||||
if ($userdata =~ s/.*QOS=\{.*?user_data=//) {
|
if ($userdata =~ s/.*QOS=\{.*?user_data=//) {
|
||||||
$userdata =~ s/\}$//;
|
$userdata =~ s/\}$//;
|
||||||
$userdata =~ s/,entity_factory=\d$//;
|
$userdata =~ s/,(?:prismtech_)?entity_factory=\d$//;
|
||||||
$userdata = " userdata:$userdata";
|
$userdata = " userdata:$userdata";
|
||||||
} else {
|
} else {
|
||||||
$userdata = "";
|
$userdata = "";
|
||||||
|
@ -320,7 +338,7 @@ while(<>) {
|
||||||
}
|
}
|
||||||
$pp{$guid} = { gid => $gid, guid => $guid, name => $name, sname => $sname, sub => {}, pub => {} };
|
$pp{$guid} = { gid => $gid, guid => $guid, name => $name, sname => $sname, sub => {}, pub => {} };
|
||||||
if (! $self_seen) {
|
if (! $self_seen) {
|
||||||
my $sysid = $guid;
|
(my $sysid = $guid) =~ s/:1c1$//;
|
||||||
$self_seen = 1;
|
$self_seen = 1;
|
||||||
$sysid{$sysid} = { self => 1, ip => $ownip, name => $name, sname => $sname };
|
$sysid{$sysid} = { self => 1, ip => $ownip, name => $name, sname => $sname };
|
||||||
my $sx = decimal_sysid($sysid);
|
my $sx = decimal_sysid($sysid);
|
||||||
|
@ -352,7 +370,9 @@ while(<>) {
|
||||||
$rwguid{$tid} = $guid; # if $is_cyclone;
|
$rwguid{$tid} = $guid; # if $is_cyclone;
|
||||||
die "$guid $rwguid{$tid}" unless $guid eq $rwguid{$tid};
|
die "$guid $rwguid{$tid}" unless $guid eq $rwguid{$tid};
|
||||||
my $topic; my $type; my $groupcoh; my $partitions; my $keepall;
|
my $topic; my $type; my $groupcoh; my $partitions; my $keepall;
|
||||||
if ($qos =~ /topic(?:_name)?=([^,]+?),type(?:_name)=([^,]+?).*?,partition=\{([^}]*?)\}/) {
|
# GUID prefix of 0:0:0: local built-in writer
|
||||||
|
my $local_builtin = ($guid =~ /^0:0:0:/);
|
||||||
|
if (! $local_builtin && $qos =~ /topic(?:_name)?="?([^,"]+?)"?,type(?:_name)="?([^,"]+?)"?.*?,partition=\{([^}]*?)\}/) {
|
||||||
$topic = $1; $type = $2; $partitions = $3;
|
$topic = $1; $type = $2; $partitions = $3;
|
||||||
die unless $qos =~ /,history=([01]):/; $keepall = $1;
|
die unless $qos =~ /,history=([01]):/; $keepall = $1;
|
||||||
die unless $qos =~ /,presentation=(\d:\d):\d/; $groupcoh = ($1 eq "2:1");
|
die unless $qos =~ /,presentation=(\d:\d):\d/; $groupcoh = ($1 eq "2:1");
|
||||||
|
@ -361,7 +381,7 @@ while(<>) {
|
||||||
}
|
}
|
||||||
$rwgid{$tid} = $psguid{$tid} = $psgid{$tid} = "" if 1; # $is_cyclone;
|
$rwgid{$tid} = $psguid{$tid} = $psgid{$tid} = "" if 1; # $is_cyclone;
|
||||||
} else {
|
} else {
|
||||||
# no topic, type: DDSI built-in reader/writer
|
# all-zero GUID prefix or no topic, type: DDSI built-in reader/writer
|
||||||
if (defined $rwgid{$tid} || $ftrflag{$tid}) {
|
if (defined $rwgid{$tid} || $ftrflag{$tid}) {
|
||||||
die;
|
die;
|
||||||
}
|
}
|
||||||
|
@ -449,8 +469,9 @@ while(<>) {
|
||||||
die;
|
die;
|
||||||
}
|
}
|
||||||
if (!defined ($wr{$wrguid}->{topic})) {
|
if (!defined ($wr{$wrguid}->{topic})) {
|
||||||
die;
|
# PMD looks like regular data but is built-in without a topic name
|
||||||
}
|
die unless $wrguid =~ /[4c][23]$/;
|
||||||
|
} else {
|
||||||
my $wr = $wr{$wrguid};
|
my $wr = $wr{$wrguid};
|
||||||
$cseq = "C#$cseq" if $cseq ne "";
|
$cseq = "C#$cseq" if $cseq ne "";
|
||||||
my $dest = getdest($wrguid);
|
my $dest = getdest($wrguid);
|
||||||
|
@ -484,8 +505,10 @@ while(<>) {
|
||||||
if $shows{out};
|
if $shows{out};
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
} elsif (/: (?:SPDP ST\d+)?SPDP ST(\d) ($guidre)\s+bes\s+([0-9a-f]+)\s+.*NEW(?: processguid ($guidre) )?.*?meta(?: (?:$proto)?[0-9.]+:\d+)*? (?:$proto)?([0-9.]+:\d+)\)/o) {
|
}
|
||||||
|
} elsif (/: (?:SPDP ST\d+)?SPDP ST(\d) ($guidre)\s+bes\s+([0-9a-f]+)\s+.*NEW(?: processguid ($guidre) )?.*?meta(?: ${proto_ip}:\d+)*? (${proto_ip}:\d+)\)/o) {
|
||||||
my $st = $1; my $ppguid = hexify($2); my $bes = hex $3; my $processguid = $4; my $ip = $5;
|
my $st = $1; my $ppguid = hexify($2); my $bes = hex $3; my $processguid = $4; my $ip = $5;
|
||||||
|
$ip =~ s/^(udp|tcp)[46]?\///;
|
||||||
my $hostname = $ip;
|
my $hostname = $ip;
|
||||||
my $sysid;
|
my $sysid;
|
||||||
if (defined $processguid) {
|
if (defined $processguid) {
|
||||||
|
@ -499,8 +522,9 @@ while(<>) {
|
||||||
# presumably OSPL: first word is system id
|
# presumably OSPL: first word is system id
|
||||||
($sysid = $ppguid) =~ s/:.*//;
|
($sysid = $ppguid) =~ s/:.*//;
|
||||||
} else {
|
} else {
|
||||||
# presumably Cyclone, old format: 2nd word is process id
|
# presumably Cyclone, old format: 2nd word is process id; new format: altogether
|
||||||
($sysid = $ppguid) =~ s/:[0-9a-f]+:1c1$//;
|
# crazy -- so don't bother with the old one
|
||||||
|
($sysid = $ppguid) =~ s/:1c1$//;
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
($sysid = $ppguid) =~ s/:1c1$//;
|
($sysid = $ppguid) =~ s/:1c1$//;
|
||||||
|
@ -562,6 +586,7 @@ while(<>) {
|
||||||
sname => $sname,
|
sname => $sname,
|
||||||
infots => $spdp_info{$ppguid}->{ts},
|
infots => $spdp_info{$ppguid}->{ts},
|
||||||
tcreate => $ts,
|
tcreate => $ts,
|
||||||
|
tasymdisc => $ts,
|
||||||
non_spdp_seen => 0,
|
non_spdp_seen => 0,
|
||||||
disccomplete => init_proxypp_disccomplete($bes),
|
disccomplete => init_proxypp_disccomplete($bes),
|
||||||
disccompleteflag => 0,
|
disccompleteflag => 0,
|
||||||
|
@ -625,7 +650,7 @@ while(<>) {
|
||||||
my $h = ($kind eq "READER") ? \%prd : \%pwr;
|
my $h = ($kind eq "READER") ? \%prd : \%pwr;
|
||||||
my $hk = ($kind eq "READER") ? "prd" : "pwr";
|
my $hk = ($kind eq "READER") ? "prd" : "pwr";
|
||||||
my $qos = $3;
|
my $qos = $3;
|
||||||
unless ($3 =~ /topic(?:_name)?=([^,]+?),type(?:_name)?=([^,]+?),(?:.+?,)?partition=\{([^}]*?)\}/) {
|
unless ($qos =~ /topic(?:_name)?="?([^,"]+?)"?,type(?:_name)?="?([^,"]+?)"?,(?:.+?,)?partition=\{([^}]*?)\}/) {
|
||||||
die unless $prwguid =~ /[4c][27]$/;
|
die unless $prwguid =~ /[4c][27]$/;
|
||||||
}
|
}
|
||||||
my $topic = $1; my $type = $2; my $partitions = $3;
|
my $topic = $1; my $type = $2; my $partitions = $3;
|
||||||
|
@ -713,7 +738,7 @@ while(<>) {
|
||||||
my $pwrguid = hexify($1); my $rdguid = hexify($2);
|
my $pwrguid = hexify($1); my $rdguid = hexify($2);
|
||||||
die unless exists $pwr{$pwrguid} || $pwrguid =~ /[4c][23]$/;
|
die unless exists $pwr{$pwrguid} || $pwrguid =~ /[4c][23]$/;
|
||||||
die unless exists $rd{$rdguid} || $rdguid =~ /[4c][74]$/;
|
die unless exists $rd{$rdguid} || $rdguid =~ /[4c][74]$/;
|
||||||
die if defined $pwr{$pwrguid}->{tdel};
|
#die if defined $pwr{$pwrguid}->{tdel}; # the order reversal is possible, however unlikely
|
||||||
#next if $pwrguid =~ /[4c]2$/;
|
#next if $pwrguid =~ /[4c]2$/;
|
||||||
$pwr{$pwrguid}->{matches}->{$rdguid} = {};
|
$pwr{$pwrguid}->{matches}->{$rdguid} = {};
|
||||||
$rd{$rdguid}->{matches}->{$pwrguid} = {};
|
$rd{$rdguid}->{matches}->{$pwrguid} = {};
|
||||||
|
@ -722,7 +747,7 @@ while(<>) {
|
||||||
my $wrguid = hexify($1); my $prdguid = hexify($2); my $bereader = $3 ne '';
|
my $wrguid = hexify($1); my $prdguid = hexify($2); my $bereader = $3 ne '';
|
||||||
die unless exists $wr{$wrguid} || $wrguid =~ /[4c][23]$/;
|
die unless exists $wr{$wrguid} || $wrguid =~ /[4c][23]$/;
|
||||||
die unless exists $prd{$prdguid} || $prdguid =~ /[4c][74]$/;
|
die unless exists $prd{$prdguid} || $prdguid =~ /[4c][74]$/;
|
||||||
die if defined $prd{$prdguid}->{tdel};
|
#die if defined $prd{$prdguid}->{tdel}; # the order reversal is possible, however unlikely
|
||||||
#next if $wrguid =~ /[4c]2$/;
|
#next if $wrguid =~ /[4c]2$/;
|
||||||
my $wr = $wr{$wrguid};
|
my $wr = $wr{$wrguid};
|
||||||
my $prd = $prd{$prdguid};
|
my $prd = $prd{$prdguid};
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue