Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
M
mp-rude
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Code Review
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Maalepaaler
mp-rude
Commits
90d3b59f
Commit
90d3b59f
authored
Feb 03, 2020
by
Olav Kvittem
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
bug in min_delay caused recomputation
parent
05131927
Pipeline
#25501
passed with stages
in 41 seconds
Changes
2
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
154 additions
and
106 deletions
+154
-106
build.sh
build.sh
+1
-1
mp-rude/usr/share/mp-rude/qstream-gap-ana
mp-rude/usr/share/mp-rude/qstream-gap-ana
+153
-105
No files found.
build.sh
View file @
90d3b59f
...
...
@@ -8,7 +8,7 @@ apt-get update
apt-get
-y
upgrade
package
=
"mp-rude"
version
=
"1.3.1
7
"
version
=
"1.3.1
8
"
target
=
"
${
package
}
_
${
version
}
_all"
...
...
mp-rude/usr/share/mp-rude/qstream-gap-ana
View file @
90d3b59f
#!/usr/bin/perl
# use strict;
# use warnings 'all';
# use PDL;
# use PDL::Ops;
# use PDL::Fit::Polynomial;
...
...
@@ -19,33 +20,34 @@ use constant JAN_1970 => 0x83aa7e80;
# use LWP::Protocol::https;
# date --date 'jan 1 2000' +%s
$version
=
"
0.1.3
";
$min_tx
=
946681200
;
$max_tx
=
1893452400
;
# 2030-01-01
$maxseqreorder
=
1000
;
#
$max_small_gap
=
10
;
# the max size of a small graph
$max_small_graphs
=
20
;
$max_big_graphs
=
20
;
$gap_limit
=
{'
big
'
=>
10000
,
'
small
'
=>
1000
,
'
tiny
'
=>
100
};
# packets
$max_gaps
=
{'
big
'
=>
10000
,
'
small
'
=>
10000
,
'
tiny
'
=>
1000
};
# count
$late_delay
=
3000
;
# ms to doom a packet late
my
%src_adr
=
(),
%dst_adr
=
();
my
$version
=
"
0.1.5
";
my
$min_tx
=
946681200
;
my
$max_tx
=
1893452400
;
# 2030-01-01
my
$maxseqreorder
=
1000
;
#
my
$max_small_gap
=
10
;
# the max size of a small graph
my
$max_small_graphs
=
20
;
my
$max_big_graphs
=
20
;
my
$gap_limit
=
{'
big
'
=>
10000
,
'
small
'
=>
1000
,
'
tiny
'
=>
100
};
# packets
my
$max_gaps
=
{'
big
'
=>
10000
,
'
small
'
=>
10000
,
'
tiny
'
=>
1000
};
# count
my
$late_delay
=
3000
;
# ms to doom a packet late
my
%src_adr
=
(),
my
%dst_adr
=
();
my
%least_delay
;
# least delay observed
my
%hostname
=
();
# parms for jitter report
my
%n_normal
=
();
# count of normal packets for modulo
my
$min_jit
=
1
;
# jitter in ms
my
$min_ddelay
=
5
;
my
$min_slope
=
0.2
;
my
$jitter_delta
=
{'
jit
'
=>
$min_jit
/5, 'ddelay'=> $min_ddelay/
5
,
'
slope
'
=>
$min_slope
/
5
};
my
$jitter_period
=
60
;
# seconds between jitter reports
my
$min_jit
=
10
;
# jitter in ms
my
$min_ddelay
=
10
;
my
$min_slope
=
0.5
;
my
$jitter_period
=
600
;
# seconds between jitter reports
my
%jitter_last
=
();
# last time jitter reported
my
%jitter_values
=
();
# last jitter values reported
my
%mindelay
;
# minimum delay last slep
my
%minseq
;
# minimum delay last slep
$usage
=
"
$0 '[-title text] [-minloss n] [-win n] [-graph file] [max-small-graphs n] [-outdir dir] [-head|-rhead] [-id id] [-names file] [-json file] [-v] [-version] [-esmond url] [file]...
my
$usage
=
"
$0 '[-title text] [-minloss n] [-win n] [-graph file] [max-small-graphs n] [-outdir dir] [-head|-rhead] [-id id] [-names file] [-json file] [-v] [-version] [-esmond url] [file]...
Analyse gaps in a crude packet log
- output a list of statistical qos parameters as text or json
- make linear regression to see the delay trend around a gap
...
...
@@ -58,17 +60,19 @@ Parameters
-owamp url - get json owamp data from pscheduler
-json file - filename to store json event documents (intended for logstash ?)
-jitter secs - emit jitter stats with secs interval
-change_factor - fraction change to cause threshold jitter report (0.3)
-threshold - jitter,ddelay,slope - threshold values for reporting
";
my
$opt_h
,
$opt_help
,
$opt_id
,
$opt_slep
,
$opt_minloss
,
$opt_win
,
$opt_max
-
small
-
graphs
,
$opt_head
,
$opt_rhead
,
$opt_graph
,
$opt_outdir
,
$opt_title
,
$opt_names
,
$opt_owamp
,
$opt_json
,
$opt_jitter
,
$opt_index
,
$opt_v
,
$opt_version
;
my
(
$opt_h
,
$opt_help
,
$opt_id
,
$opt_slep
,
$opt_minloss
,
$opt_win
,
$opt_recover
,
$opt_max_small_graphs
,
$opt_head
,
$opt_rhead
,
$opt_graph
,
$opt_outdir
,
$opt_title
,
$opt_names
,
$opt_threshold
,
$opt_owamp
,
$opt_json
,
$opt_jitter
,
$opt_change_factor
,
$opt_index
,
$opt_v
,
$opt_version
)
;
GetOptions
(
'
h
'
=>
\
$opt_h
,
'
help
'
=>
\
$opt_help
,
'
id=s
'
=>
\
$opt_id
,
'
slep=s
'
=>
\
$opt_slep
,
'
minloss=s
'
=>
\
$opt_minloss
,
'
win=s
'
=>
\
$opt_win
,
'
max-small-graphs=s
'
=>
\
$opt_max
-
small
-
graphs
,
'
minloss=s
'
=>
\
$opt_minloss
,
'
win=s
'
=>
\
$opt_win
,
'
recover=s
'
=>
\
$opt_recover
,
'
max-small-graphs=s
'
=>
\
$opt_max_small_graphs
,
'
head
'
=>
\
$opt_head
,
'
rhead
'
=>
\
$opt_rhead
,
'
graph=s
'
=>
\
$opt_graph
,
'
outdir=s
'
=>
\
$opt_outdir
,
'
title=s
'
=>
\
$opt_title
,
'
names=s
'
=>
\
$opt_names
,
'
json=s
'
=>
\
$opt_json
,
'
index=s
'
=>
\
$opt_index
,
'
jitter=s
'
=>
\
$opt_jitter
,
'
threshold
'
=>
\
$opt_threshold
,
'
owamp=s
'
=>
\
$opt_owamp
,
'
v
'
=>
\
$opt_v
,
'
version
'
=>
\
$opt_version
)
'
change_factor=s
'
=>
\
$opt_change_factor
,
'
v
'
=>
\
$opt_v
,
'
version
'
=>
\
$opt_version
)
or
die
$usage
;
# &NGetOpt( 'h', 'help', 'id=s', 'slep=s', 'minloss=s', 'win=s', 'max-small-graphs=s', 'head', 'rhead', 'graph=s', 'outdir=s', 'title=s', 'names=s', 'json=s', 'index=s', 'v', 'version') || die "$!" . $usage ."\n";
...
...
@@ -88,16 +92,20 @@ if ($opt_owamp){
}
if
(
$opt_threshold
){
(
$min_jit
,
$min_dddelay
,
$min_slope
)
=
split
('
,
',
$opt_threshold
);
my
(
$min_jit
,
$min_dddelay
,
$min_slope
)
=
split
('
,
',
$opt_threshold
);
}
my
$jitter_delta
=
{'
jit
'
=>
$min_jit
/2, 'ddelay'=> $min_ddelay/
2
,
'
slope
'
=>
$min_slope
/
2
};
$jitter_period
=
$opt_jitter
if
$opt_jitter
;
my
$change_factor
=
$opt_change_factor
||
0.3
;
my
$jitter_factor
=
{'
jit
'
=>
$change_factor
,
'
ddelay
'
=>
$change_factor
,
'
slope
'
=>
$change_factor
};
my
@heads
=
qw/id date time tunix x1 nloss tloss seqloss x2 seqtail overlap x3 h_n h_jit h_ddelay h_delay h_min_d h_slope_10 h_slope_20 h_slope_30 h_slope_40 h_slope_50 x4 t_n t_jit t_ddelay t_delay t_min_d t_slope_10 t_slope_20 t_slope_30 t_slope_40 t_slope_50 dTTL/
;
if
(
$opt_rhead
){
my
@a
=
split
("
",
$
head
);
@heads
=
split
("
",
$opt_r
head
);
my
$h
=
"";
foreach
$a
(
@heads
){
$h
.=
'
"
'
.
$a
.
'
",
'
}
...
...
@@ -109,7 +117,7 @@ if ($opt_rhead){
}
my
%hix
=
();
# hash on name to index in @heads
foreach
$i
(
0
..
$#heads
){
foreach
my
$i
(
0
..
$#heads
){
$hix
{
$heads
[
$i
]}
=
$i
;
}
my
$coder
;
# json coder
...
...
@@ -122,7 +130,7 @@ if ( $opt_json){
open
JSON
,
"
>>
$json
"
||
die
"
Could not open
$json
; $!
";
# $coder = JSON::XS->new->ascii->pretty->allow_nonref;
$coder
=
JSON::
XS
->
new
->
ascii
->
allow_nonref
;
$encoder
=
$coder
->
canonical
([
1
]);
my
$encoder
=
$coder
->
canonical
([
1
]);
# use of this ?
}
...
...
@@ -139,25 +147,28 @@ if ( $opt_names){
$maxslep
=
$opt_slep
||
1000
;
$maxhead
=
$opt_win
||
10
;
# packets to keep before
$maxtail
=
$opt_win
||
10
;
# packets to keep after
$min_slopes
=
5
;
# slopes to report on text report
$minloss
=
$opt_minloss
||
1
;
$minrecover
=
$opt_recover
||
5
;
$outdir
=
$opt_outdir
||
"
.
";
$title
=
$opt_title
||
'
Delay
';
$bv_fmt
=
'
^([\d]+)\s+([\d\.\:]+)\s+([\d\.]+)\s+([\d\.]+)
';
# BV's condensed format for crude
my
$maxslep
=
$opt_slep
||
10000
;
my
$maxhead
=
$opt_win
||
10
;
# packets to keep before
my
$maxtail
=
$opt_win
||
10
;
# packets to keep after
my
$min_slopes
=
5
;
# slopes to report on text report
my
$minloss
=
$opt_minloss
||
1
;
my
$minrecover
=
$opt_recover
||
5
;
my
$outdir
=
$opt_outdir
||
"
.
";
my
$title
=
$opt_title
||
'
Delay
';
my
$crude_fmt
=
'
^ID=(\d+) SEQ=(\d+) SRC=([\w\:\.]+):\d+ DST=([\w\:\.]+):\d+.*Tx=([\d\.]+) .*Rx=([\d\.]+) .*SIZE=(\d+)
';
my
$bv_fmt
=
'
^([\d]+)\s+([\d\.\:]+)\s+([\d\.]+)\s+([\d\.]+)
';
# BV's condensed format for crude
$exp_num
=
'
[\d\.e\-]+
';
# 2.32831e-10
$owamp_fmt
=
'
^(\d+)\s+(\d+)\s+($exp_num)\s+(\d+)\s+(\d+)\s+($exp_num)\s+(\d+)
';
$id
=
$opt_id
||
"
ukjent
"
;
my
$exp_num
=
'
[\d\.e\-]+
';
# 2.32831e-10
my
$owamp_fmt
=
'
^(\d+)\s+(\d+)\s+($exp_num)\s+(\d+)\s+(\d+)\s+($exp_num)\s+(\d+)
';
my
$id
=
$opt_id
||
"
ukjent
"
;
my
%npackets
=
();
# keep track of all ids
my
$print_line
;
my
%duration
;
# seconds per id
my
%late_n
=
();
my
$t0
;
# start time for each source
my
$last_tx
;
# last tx seen
my
%last_tx
;
# last tx seen
my
%t0
=
();
my
(
%late_sum
,
%nsmall_gaps
,
%nbig_gaps
);
if
(
$opt_owamp
){
if
(
$opt_owamp
=~
/^http.*:\/\//
){
...
...
@@ -327,13 +338,12 @@ sub emit_json{
################################################################################
sub
get_names
{
$file
=
shift
;
if
(
open
NAMES
,
"
<
$file
"
){
while
(
<
NAMES
>
){
next
if
/^\s*#/
;
(
$name
,
$user
,
$dns
,
$ip
)
=
split
;
my
(
$name
,
$user
,
$dns
,
$ip
)
=
split
;
$hostname
{
$ip
}
=
$name
;
}
close
NAMES
;
...
...
@@ -342,6 +352,23 @@ sub get_names {
}
}
sub
get_name
{
my
$adr
=
shift
;
my
$name
;
if
(
$hostname
{
$adr
}){
$name
=
$hostname
{
$adr
};
}
else
{
if
(
$hostname
=
gethostbyaddr
(
inet_aton
(
$adr
),
AF_INET
)
){
$name
=
$hostname
;
}
else
{
$name
=
$adr
;
}
$hostname
{
$adr
}
=
$name
;
}
return
$name
;
}
################################################################################
sub
owptime2datetime
{
my
(
$owptime
)
=
@_
;
...
...
@@ -421,16 +448,15 @@ sub read_crude {
# die "### Versjon med feil i Rx : $_";
}
my
$seq
;
if
(
/crude version/
){
# new file restart sequence control
undef
%pseq
,
%slep
,
%gap_slep
,
%slep_data
,
%gap_data
;
}
elsif
(
(
(
$rudeid
,
$seq
,
$src
,
$dst
,
$tx
,
$rx
,
$size
)
=
/^ID=(\d+) SEQ=(\d+) SRC=([\w\:\.]+):\d+ DST=([\w\:\.]+):\d+.*Tx=([\d\.]+) .*Rx=([\d\.]+) .*SIZE=(\d+)/
)
||
(
(
$seq
,
$tx
,
$ssync
,
$serr
,
$rx
,
$rsync
,
$rerr
,
$ttl
)
=
/$owamp_fmt/
)
||
(
(
$seq
,
$src
,
$tx
,
$rx
)
=
/$bv_fmt/
)
){
if
(
(
my
(
$rudeid
,
$seq
,
$src
,
$dst
,
$tx
,
$rx
,
$size
)
=
/$crude_fmt/
)
)
{
next
if
$size
<
50
;
# just a sanity filter for the packets i harstad-mp that has SIZE=4
analyze_packet
(
$seq
,
$src
,
$dst
,
$tx
,
$rx
);
}
elsif
(
/crude version/
){
# new file restart sequence control
undef
%pseq
,
%slep
,
%gap_slep
,
%slep_data
,
%gap_data
;
}
elsif
(
(
my
(
$seq
,
$tx
,
$ssync
,
$serr
,
$rx
,
$rsync
,
$rerr
,
$ttl
)
=
/$owamp_fmt/
)
||
(
my
(
$seq
,
$src
,
$tx
,
$rx
)
=
/$bv_fmt/
)
){
analyze_packet
(
$seq
,
$src
,
$dst
,
$tx
,
$rx
);
}
}
}
...
...
@@ -442,20 +468,6 @@ sub gap_type {
}
}
sub
get_name
{
my
$adr
=
shift
;
if
(
$hostname
{
$adr
}){
$name
=
$hostname
{
$adr
};
}
else
{
if
(
$hostname
=
gethostbyaddr
(
inet_aton
(
$adr
),
AF_INET
)
){
$name
=
$hostname
{
$adr
}
=
$hostname
;
}
else
{
$name
=
$hostname
{
$adr
}
=
$adr
;
}
}
return
$name
;
}
sub
analyze_packet
{
my
(
$seq
,
$src
,
$dst
,
$tx
,
$rx
)
=
@_
;
if
(
$opt_id
){
...
...
@@ -490,7 +502,7 @@ sub analyze_packet {
$late_ss
{
$id
}
+=
$dt*$dt
;
$bufferit
=
0
;
}
elsif
(
$dseq
==
1
){
# normal packet
if
(
$ntail_seq
{
$id
}
>
0
){
# is recovering
if
(
$ntail_seq
{
$id
}
&&
$ntail_seq
{
$id
}
>
0
){
# is recovering
$ntail_seq
{
$id
}
++
;
if
(
$ntail_seq
{
$id
}
>
$minrecover
&&
$in_gap
{
$id
}
){
my
$gap_type
=
gap_type
(
$missing
);
...
...
@@ -584,7 +596,7 @@ sub analyze_packet {
$gap_slep
{
$id
}
=[]
;
$gap_data
{
$id
}
=[]
;
$nbig_gaps
{
$id
}
++
;
$big_gaps
{
$id
}
+=
$dseq
-
1
;
#
$big_gaps{$id}+=$dseq-1;
$big_time
{
$id
}
+=
$tx
-
$ptx
{
$id
};
}
else
{
$nsmall_gaps
{
$id
}
++
;
...
...
@@ -624,7 +636,7 @@ sub analyze_packet {
}
}
}
$in_gap
{
$id
}
=
0
if
$ntail_seq
{
$id
}
<
1
;
$in_gap
{
$id
}
=
0
if
!
$ntail_seq
{
$id
}
||
$ntail_seq
{
$id
}
<
1
;
# handle tail
# count up multiple possibly overlapping tails
...
...
@@ -638,10 +650,10 @@ sub analyze_packet {
# }
#
# foreach $i (0 .. $#{$ntail{$id}}){
if
(
$nbreak
{
$id
}
>
0
&&
(
$ntail
{
$id
}[
0
]
>=
$maxtail
)){
if
(
$nbreak
{
$id
}
>
0
&&
$ntail
{
$id
}
&&
(
$ntail
{
$id
}[
0
]
>=
$maxtail
)){
my
$head
=
shift
(
@
{
$head1
{
$id
}});
push
(
@
{
$tail
{
$id
}},
report_delay
(
$id
,
'
tail
',
\
@
slep_data
{
$id
}),
0
,
0
);
push
(
@
{
$tail
{
$id
}},
report_delay
(
$id
,
'
tail
',
\
$
slep_data
{
$id
}),
0
,
0
);
$print_line
.=
sprintf
"
%s overlap %8d %2d
",
$head
,
$head_seq
{
$id
},
$#
{
$ntail
{
$id
}}
+
1
;
shift
(
@
{
$ntail
{
$id
}});
&emit_stats
(
$id
);
...
...
@@ -655,13 +667,16 @@ sub analyze_packet {
################################################################################
# find minimum of a member var in an array of hashes
sub
get_min
{
my
(
$
var
,
$refd
)
=
@_
;
my
(
$
refd
,
$var
,
$pos
)
=
@_
;
my
$min
;
my
$rd
=
$$refd
;
foreach
$rd
(
@$rd
){
$min
=
$rd
->
{
$var
}
if
!
$rd
->
{
$var
}
||
$rd
->
{
$var
}
<
$min
;
if
(
!
$min
||
$rd
->
{
$var
}
<
$min
){
$min
=
$rd
->
{
$var
};
$seq
=
$rd
->
{
$pos
};
}
}
return
$min
;
return
(
$min
,
$seq
)
;
}
################################################################################
...
...
@@ -679,9 +694,15 @@ sub jitter_change {
}
return
0
;
}
sub
val_change
{
my
(
$id
,
$var
,
$val
)
=
@_
;
if
(
abs
(
abs
$val
-
$jitter_values
{
$id
}
->
{
$var
}
)
>
$jitter_delta
->
{
$var
}
){
# if ( abs (abs $val - $jitter_values{$id}->{$var} ) > $jitter_delta->{$var} ){
my
$prev
=
$jitter_values
{
$id
}
->
{
$var
};
my
$delta
=
$val
-
$prev
;
# if ( abs ( $delta ) > $jitter_factor->{$var} * $prev ){
if
(
abs
(
$delta
)
>
$jitter_delta
->
{
$var
}
){
return
1
;
# true
}
return
0
;
# false
...
...
@@ -696,7 +717,8 @@ sub check_jitter{
if
(
$start
>=
0
){
$tstart
=
$slep_data
{
$id
}[
$start
]{
tx
};
my
$l
=
report_delay
(
$id
,
'
stats
',
\
@slep_data
{
$id
},
NULL
,
0
);
my
$r
=
report_delay
(
$id
,
'
stats
',
\
$slep_data
{
$id
},
NULL
,
0
);
my
$l
=
$$r
{
line
};
$l
=~
s/^\s*//
;
my
(
$n
,
$jit
,
$ddelay
,
$delay
,
$min_d
,
$slope_10
,
$slope_20
,
$slope_30
,
$slope_40
,
$slope_50
)
=
split
(
/\s+/
,
$l
);
...
...
@@ -705,25 +727,29 @@ sub check_jitter{
$jitter_last
{
$id
}
=
$tstart
;
}
my
$report_type
=
'
threshold
';
if
(
$tstart
>=
(
$jitter_last
{
$id
}
+
$jitter_period
)
){
my
$report_type
=
'
none
';
if
(
abs
$jit
>
$min_jit
||
$ddelay
>
$min_ddelay
||
abs
$slope_50
>
$min_slope
)
{
#
$report_type
=
'
threshold
';
}
elsif
(
$tstart
>=
(
$jitter_last
{
$id
}
+
$jitter_period
)
){
$report_type
=
'
interval
';
}
if
(
$report_type
eq
'
interval
'
# periodic or by threshhold
||
(
abs
$jit
>
$min_jit
||
$ddelay
>
$min_ddelay
||
abs
$slope_50
>
$min_slope
)
){
#
if
(
jitter_change
(
$id
,
$jit
,
$ddelay
,
$slope50
)
){
if
(
$report_type
eq
'
interval
'
||
$report_type
eq
'
threshold
'
# interval or by threshhold
&&
jitter_change
(
$id
,
$jit
,
$ddelay
,
$slope50
)
){
# emit_jitter_json(\$l);
my
$json
=
{
"
event_type
"
=>
"
jitter
",
"
report_type
"
=>
$report_type
,
"
h_n
"
=>
$n
*
1
,
"
h_jit
"
=>
$jit
*
1.0
,
"
h_ddelay
"
=>
$ddelay
*
1.0
,
"
h_delay
"
=>
$delay
*
1.0
,
"
h_min_d
"
=>
$min_d
*
1.0
# "h_slope_10" => $slope_10 * 1.0,
"
report_type
"
=>
$report_type
,
"
h_n
"
=>
$n
*
1
,
"
h_jit
"
=>
$jit
*
1.0
,
"
h_ddelay
"
=>
$ddelay
*
1.0
,
"
h_delay
"
=>
$delay
*
1.0
,
"
h_min_d
"
=>
$min_d
*
1.0
,
"
rtx
"
=>
$$r
{
rtx
},
"
rdelay
"
=>
$$r
{
rdelay
},
"
slopes
"
=>
$$r
{
slopes
},
"
h_slope_10
"
=>
$slope_10
*
1.0
# "h_slope_20" => $slope_20 * 1.0,
# "h_slope_30" => $h_slope_30 * 1.0,
# "h_slope_40" => $h_slope_40 * 1.0,
...
...
@@ -731,12 +757,25 @@ sub check_jitter{
};
emit_json
(
$json
,
$id
,
$tstart
);
$jitter_last
{
$id
}
=
$tstart
;
}
jitter_stats
(
$jit
);
}
}
else
{
# ignore
}
}
sub
jitter_reg
{
my
(
$id
,
$r
,
$var
)
=
@_
;
push
(
@
{
$jitter_obs
{
$id
}{
$var
}},
$r
{
$var
}
);
}
sub
jitter_stats
{
my
(
$id
,
$r
)
=
@_
;
#
jitter_reg
(
$id
,
$r
,
"
h_jit
");
jitter_reg
(
$id
,
$r
,
"
h_ddelay
");
jitter_reg
(
$id
,
$r
,
"
h_min_d
");
jitter_reg
(
$id
,
$r
,
"
h_delay
");
jitter_reg
(
$id
,
$r
,
"
h_slope_10
");
}
################################################################################
...
...
@@ -760,14 +799,14 @@ sub emit_break_head {
# my $dt= $rx2 - $tx1 - $min_delay;
my
$dt
=
$tx2
-
$tx1
-
&p_interval
(
$slep
{
$id
});
# clock from same side more accurate diff
(
$sec
,
$min
,
$hour
,
$mday
,
$mon
,
$year
,
$wday
,
$yday
,
$isdst
)
=
my
(
$sec
,
$min
,
$hour
,
$mday
,
$mon
,
$year
,
$wday
,
$yday
,
$isdst
)
=
localtime
(
$tx1
);
push
(
@
{
$head1
{
$id
}},
sprintf
"
%-25s %4d-%02d-%02d %02d:%02d:%02d %s gap %5d %5.1f %6d
",
$id
,
$year
+
1900
,
$mon
+
1
,
$mday
,
$hour
,
$min
,
$sec
,
$tx1
,
$dseq
-
1
,
$dt
*
1000
,
$head_seq
{
$id
}
-
$seq0
{
$id
}
);
push
(
@
{
$ntail
{
$id
}},
0
);
# remember this break
push
(
@
{
$head
{
$id
}},
report_delay
(
$id
,
'
head
',
\
@
slep_data
{
$id
},
$tx1
,
$dt
));
push
(
@
{
$head
{
$id
}},
report_delay
(
$id
,
'
head
',
\
$
slep_data
{
$id
},
$tx1
,
$dt
));
# @slep{$id}=();
# $nslep{$id}=0;
}
...
...
@@ -821,8 +860,10 @@ sub emit_stats{
# printf "head %3d %s tail %3d %s\n", $#{$head{$id}}+1, &report_delay($head{$id}),
if
(
$#lostseq
>=
0
){
# still lost packets later (reorder)
$print_line
.=
sprintf
"
head %s tail %s %5d
\n
",
shift
(
@
{
$head
{
$id
}}),
shift
(
@
{
$tail
{
$id
}}),
shift
(
@
{
$dttl
{
$id
}});
print_line
(
\
$print_line
);
my
$h
=
shift
(
@
{
$head
{
$id
}});
my
$t
=
shift
(
@
{
$tail
{
$id
}});
$print_line
.=
sprintf
"
head %s tail %s %5d
\n
",
$$h
{
line
},
$$t
{
line
},
shift
(
@
{
$dttl
{
$id
}});
print_line
(
\
$print_line
,
$h
);
}
else
{
$print_line
=
'';
# print stderr "reordering fixed : $print_line\n";
...
...
@@ -848,7 +889,7 @@ sub report_delay{ # jitter for one delay
my
$taildelay
;
# in tail/head
my
@rdelay
=
(),
@rtx
=
(),
$tx0
=
0
;
my
@rrx
=
(),
$rx0
=
0
;
my
$rudeid
,
$seq
,
$src
,
$dst
,
$tx
,
$rx
,
$size
,
$pseq
;
my
(
$rudeid
,
$seq
,
$src
,
$dst
,
$tx
,
$rx
,
$size
,
$pseq
)
;
my
$start
=
$#
{
$$refd
}
-
$maxhead
;
...
...
@@ -895,14 +936,14 @@ sub report_delay{ # jitter for one delay
}
$ptx
=
$tx
;
$prx
=
$rx
;
$pdelay
=
$delay
;
#
$pdelay=$delay;
$pseq
=
$seq
;
}
}
my
$d
=
$$refd
;
if
(
$d
->
[
0
]{
seq
}
>
$minseq
{
$id
}
){
# minimum of last maxslep packets
$mindelay
{
$id
}
=
get_min
('
delay
',
$refd
);
(
$mindelay
{
$id
},
$minseq
{
$id
})
=
get_min
(
$refd
,
'
delay
',
'
seq
'
);
}
...
...
@@ -914,7 +955,7 @@ sub report_delay{ # jitter for one delay
if
(
$njit
>
0
){
$lineFit
=
Statistics::
LineFit
->
new
();
my
@slope
=
(),
$slopes
=
"";
my
$lr_start
;
my
$lr_a
;
my
$lr_b
;
my
@slope
s
=
(),
my
$slopes
=
"";
my
$lr_start
;
my
$lr_a
;
my
$lr_b
;
my
$cc
;
# chart object
my
$ctx
;
# chart context
...
...
@@ -946,7 +987,7 @@ sub report_delay{ # jitter for one delay
}
foreach
(
$i
=
0
;
$i
<
$#rtx
-
4
;
$i
+=
10
){
my
$lr_start
,
$lr_end
;
my
(
$lr_start
,
$lr_end
)
;
if
(
$type
eq
"
head
"){
# analyze head from end and tail from start
$lr_start
=
$i
;
$lr_end
=
$#rtx
;
}
else
{
...
...
@@ -959,7 +1000,8 @@ sub report_delay{ # jitter for one delay
# virker ikke
# ($yfit, $coeffs) = fitpoly1d \@drtx, \@drdelay, 4; # Fit a cubi
if
(
$type
eq
'
stats
'
&&
0
){
# save on slope LR for jitter
my
$slope
;
if
(
$type
eq
'
stats
'
){
# save on slope LR for jitter
$slope
=
$intercept
=
0
;
}
else
{
$lineFit
->
setData
(
\
@drtx
,
\
@drdelay
);
...
...
@@ -967,7 +1009,7 @@ sub report_delay{ # jitter for one delay
warn
"
File
$ARGV
: $!
";
}
}
push
(
@slope
,
sprintf
("
%9.3f
",
$slope
)
);
push
(
@slope
s
,
sprintf
("
%9.3f
",
$slope
)
);
# $slopes.=sprintf("%9.3f ", $slope);
$lr_a
=
$slope
;
$lr_b
=
$intercept
;
...
...
@@ -997,17 +1039,19 @@ sub report_delay{ # jitter for one delay
}
# make sure all columns are filled in
while
(
$#slope
<
(
$min_slopes
-
1
)){
push
(
@slope
,
"
-
");
}
$slopes
=
join
('
',
@slope
);
return
sprintf
"
%3d %9.3f %9.3f %9.3f %9.3f %s
",
$njit
,
$sumjit
/$njit*1000, $sumdd/
$njit
*
1000
,
$slopes
=
join
('
',
@slopes
);
for
(
my
$i
=
$#slopes
;
$i
<
$min_slopes
;
$i
++
){
$slopes
.=
"
-
";
}
my
%rec
=
(
n
=>
$njit
,
jit
=>
$sumjit
/$njit*1000, ddelay=>$sumdd/
$njit
*
1000
,
delay
=>
$sumdelay
/
$njit
*
1000
,
min_d
=>
$mindelay
{
$id
}
*
1000
,
slopes
=>\
@slopes
,
rtx
=>\
@rtx
,
rdelay
=>\
@rdelay
);
$rec
{
line
}
=
sprintf
"
%3d %9.3f %9.3f %9.3f %9.3f %s
",
$njit
,
$sumjit
/$njit*1000, $sumdd/
$njit
*
1000
,
$sumdelay
/
$njit
*
1000
,
$mindelay
{
$id
}
*
1000
,
$slopes
;
return
\
%rec
;
}
else
{
return
sprintf
"
%3d %5.3f %5.3f
",
0
,
0
,
0
;
}
}
}
# report_delay
sub
min
{
return
$_
[
0
]
if
$_
[
0
]
<=
$_
[
1
]
;
...
...
@@ -1020,7 +1064,7 @@ sub max{
foreach
$v
(
@$ref
){
$max
=
$v
if
!
$max
||
$max
<
$v
;
}
return
max
;
return
$
max
;
}
# generate header form based on first data line
...
...
@@ -1039,6 +1083,7 @@ sub headmaker{
sub
print_line
{
my
$line
=
shift
;
my
$r
=
shift
;
# the head object
if
(
!
$head_done
){
if
(
$opt_head
&&
$opt_v
){
printf
headmaker
(
$$line
)
.
"
\n
",
@heads
;
...
...
@@ -1046,7 +1091,7 @@ sub print_line{
$head_done
=
1
;
}
if
(
$opt_json
){
emit_event_json
(
$line
);
emit_event_json
(
$line
,
$r
);
}
if
(
$opt_v
){
print
$$line
;
...
...
@@ -1056,6 +1101,7 @@ sub print_line{
sub
emit_event_json
{
my
$line
=
shift
;
my
$r
=
shift
;
if
(
$$line
=~
/\d\d\d\d-\d\d-\d\d\s+\d\d:/
){
#looks like report line : yyy-mm-dd hh:
my
@f
=
split
(
/\s+/
,
$$line
);
my
$from
=
$f
[
$hix
{
id
}];
...
...
@@ -1094,7 +1140,9 @@ sub emit_event_json{
"
t_slope_40
"
=>
$f
[
$hix
{
t_slope_40
}]
*
1.0
,
"
t_slope_50
"
=>
$f
[
$hix
{
t_slope_50
}]
*
1.0
,
"
overlap
"
=>
$f
[
$hix
{
overlap
}]
*
1
,
"
dTTL
"
=>
$f
[
$hix
{
dTTL
}]
*
1
"
dTTL
"
=>
$f
[
$hix
{
dTTL
}]
*
1
,
"
rtx
"
=>
$$r
{
rtx
},
"
rdelay
"
=>
$$r
{
rdelay
}
# "" => $f[$hix{}],
};
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment