Commit 7e8f6df6 authored by paalmm's avatar paalmm

updates: fixed MPEG-ts bugs and implemented support for XML,rtmp and tcp

parent a3e4ded8
......@@ -13,74 +13,55 @@ use IO::Select;
use Net::Pcap;
use NetPacket::Ethernet qw(:strip);
use NetPacket::IP;
use NetPacket::IP qw(:protos);
use NetPacket::IP qw(:strip :protos);;
use NetPacket::UDP;
use Net::RTP;
use NetPacket::TCP;
#use Net::RTP;
use Net::RTP::Packet;
use Time::HiRes qw/ sleep time tv_interval gettimeofday/;
use Data::Dumper;
use threads;
use threads::shared;
use Pod::Usage;
#use bigint qw/ hex oct/;
use Math::BigInt;
use Math::BigFloat;
use Carp;
#RTMP implementation *experimental*
use rtmp::client qw(rtmp_connect rtmp_play rtmp_call get_chunk_ids);
use constant MTU => 1580;
#XML
use XML::DOM;
use XML::Twig;
#use mpegpackets;
$DEFAULT_PORT = 1955;
my $timeout=1 ; # frac seconds to wait for receiving packets
#my oh my,more globals
my ($rtmp,$period,$last,$debug,$swfurl,$pageurl,$flash_version,$reconnect);
require "newgetopt.pl";
$usage="$0 [option]... [file...|ip/|:port]...
-list list flows in files
-dump dump data part to file
-format [full|pretty] print full numbers foror short pretty numbers
-net open network stream rather than file(s)
-crude the log is from crude
-bins bins for gaps in ms : b1,b2,,,
-log log gaps longer than 1 (use with crude)
-rtp look forinto rtp headers (default just udp)
-mpeg decode mpeg-2 transport stream and look for sequence and mediatime
-rtt roundtrip - round trip time in ms (for MOS)
-codec codec - codec G.711, G.723.1, G.729A, iLBC (G.711)
-pcap listen to all multicast groups with pcap at the same time
-period seconds - period in seconds between stats output
-nperiod number of periodes
-last seconds - exit after seconds
-packets packets - exit after packets
-src source - limit stats to given source
-flow_key flow key - limit stats to this flow(src_ip:src_port->dest_ip:dest_port)
-flow_no flow no - limit stats to this flow no from -list
-flow_min numb - discard flows with less packets that numb
-nohead - no headings for batch use
-id name - report name instead of flow_key in flows
-sum name - make a summary of all flows to name rather than per flow
-ttl - print ttl values for stream
-verbose - more details packet distances and sizes
-debug - print debugging info
-help/h this message
\n";
@opts=('list', 'fullformat', 'net', 'rtp', 'mpeg', 'pcap', 'crude', 'bins=s', 'log', 'nperiod=s', 'period=s', 'last=s', 'packets=s', 'src=s', 'flow_key=s', 'flow_no=s', 'flow_min=s', 'nohead', 'dump=s', 'format=s', 'id=s', 'sum=s', 'ttl', 'rtt=s', 'codec=s', 'log', 'verbose', 'v', 'help', 'h', 'debug');
&NGetOpt(@opts) || die $usage;
die $usage if $opt_h or $opt_help;
@opts=('list', 'man','fullformat', 'net', 'rtp', 'mpeg', 'pcap', 'crude', 'bins=s', 'log', 'nperiod=s', 'period=s', 'last=s', 'packets=s', 'src=s', 'flow_key=s', 'flow_no=s', 'flow_min=s', 'nohead', 'dump=s', 'format=s', 'id=s', 'sum=s', 'ttl', 'rtt=s', 'codec=s', 'log', 'verbose', 'v', 'h', 'debug', 'av','xml=s', 'rtmp','tcp', 'port=s','swfurl=s','pageurl=s','flashversion=s','new','q','exclude=s','report=s');
&NGetOpt(@opts) || die pod2usage(1);
die pod2usage(1) if $opt_h;
$continous= ! $opt_packets;
$opt_v=$opt_v or $opt_verbose;
my $codec = $opt_codec || 'G.711';
my $rtt = $opt_rtt || 10; # ms round trip time of the connection
pod2usage(-verbose => 2 ) if $opt_man;
my @streams=@ARGV;
if ($opt_bins){
@bins=split(/,/, $opt_bins);
}
if ($opt_report){
@filter=split(/,/, $opt_report);
}
my $format = $opt_format || "pretty";
my %hdr=();
my $err="";
my $us=0; # current packet time in us
......@@ -88,10 +69,46 @@ my $nkill=0;
my $nint=0;
my $n_packets=0;
my $endstream=0;
my $period_num = 0;
my $pcr_count = 0;
my $pts_count = 0;
my $doc;
my $xml;
my $xml_printed= 0;
my $last_stream;
my $file_flag;
#TCP STUFF
my $thr;
my $rtmp_port:shared = 1935;
my $rtmp_addr:shared;
my %tcp_packet_stats:shared = ();
my %bw_stats:shared = ();
my %seq_stats:shared = ();
my %seq_stats_n =();
my $n_seq_num:shared=0;
my $rtmp_stream_start:shared;
my $tcp_stop:shared;
my %hash : shared;
my $packet_re_num:shared=0;
$seq_stats{'p_seq_num'} = 0;
$seq_stats{'p_tcp_time_stamp'} = 0;
$seq_stats{'p_tcp_time_stamp_echo'} = 0;
$seq_stats{'real_last_time'} = 0;
#init packetstats
$tcp_packet_stats{'pkt_lost'} = 0;
$tcp_packet_stats{'pkt_late'} = 0;
$tcp_packet_stats{'pkt_dup'} = 0 ;
$tcp_packet_stats{'pkt_retrans'} = 0;
my $start_time = time();
#MPEG-TS measurement globals (most are reset in init)
my $CHECK_NUM_TSP = 2;
#globals for mpeg ts
#a tabel for transport streams pids. aleternativ to PAT impl.
my $TS;
my @cc = ();
my $discontinuities = 0;
my %last_ccs = ();
......@@ -104,6 +121,8 @@ my %pcr_stats = ();
#PTS-stats {filename/handle}
my %pts_stats = ();
my %mpeg_stats = ();
my %jitter_stats = ();
#PTS stuff
#my $real_time = time();
my $late_video_packets = 0;
......@@ -117,22 +136,24 @@ my %dist1 = ();
my %dist2 = ();
$opt_period = $opt_last if not $opt_period;
#MPEG-TS END
#MPEG-TS END
$SIG{USR2} = sub {confess "Caught by SIGUSR2"; };
$SIG{INT} = sub { $uninterrupted=0; # return if $nint++ < 1;
&display_stats(); die "End after interrupt.\n";exit(0) };
&display_stats();
&end_xml() if $opt_xml;
&handle_threads() if ($opt_tcp and $opt_rtmp);
die "End after interrupt.\n";exit(0) };
$SIG{KILL} = sub { $uninterrupted=0; # return if $nkill++ < 1;
&display_stats(); die "End after kill.\n";exit(0) };
$SIG{ALRM} = sub {
# Writes stats to file if option XML is given. -PMM
# die "No packets received" if $n_packets < 1;
# $uninterrupted=0;
&display_stats if ! $endstream;
&display_stats() if !$endstream;
# die "End after alarm\n";
# return(0);
$endstream=1;
......@@ -143,23 +164,26 @@ if ($opt_dump){
open DUMP, ">$opt_dump";
}
# $wanted_flow = $opt_flow_key;
if ($opt_pcap){ # listen in parallell
if ($opt_pcap || ($opt_tcp && !$opt_rtmp)){ # listen in parallell
alarm($opt_last) if $opt_last;
$uninterrupted=1;
$endstream=0;
eat_pcap_streams(@streams);
&display_stats();
&display_stats() if !$opt_xml;
} else { # listen serially
my $stream_count;
my $ln = @streams;
foreach $id (@streams) {
alarm($opt_last) if $opt_last;
alarm($opt_last) if $opt_last;
++$stream_count;
$last_stream = 1 if $stream_count == ($ln);
#print "count $stream_count lengde $ln \n";
$uninterrupted=1;
$endstream=0;
init_file($id);
eat_stream($id);
eat_stream($id) if (!($opt_tcp || $opt_rtmp));
&rtmp_eat_stream($id,$opt_period, $opt_last,0,$opt_debug,$opt_swfurl,$opt_pageurl,$opt_flashversion) if $opt_rtmp;
&eat_tcp($id,$opt_port) if $opt_tcp && !$opt_rtmp;
if (! ( $opt_list || $opt_sum)){
&display_stats() if !$endstream;
}
......@@ -169,17 +193,277 @@ if ($opt_pcap){ # listen in parallell
&list_flows if $opt_list;
&display_stats() if $opt_sum;
&display_bins if $opt_bins;
&end_xml() if $opt_xml;
exit(0);
sub http_stream_client {
my $f = shift;
my $playlist = get("$f");
my @list_items = split(/\n/,$playlist);
my @streams;
my $duration;
my $regex = "http://";
my $p_chunk;
while(1){
foreach my $item (@list_items){
my @tmp_streams= get("$item");
if ($item=~ /$regex/g){
foreach my $stream (@tmp_streams){
if ($stream =~ /EXT-X-TARGETDURATION/){
my @temp = split(/:/,$stream);
$duration = $temp[1];
}
if($stream !~ /#/g){
push(@streams,$stream);
my $l = @streams;
my $current_chunk = $streams[$l-1];
if ($current_chunk ne $p_chunk){
my $data = get("$current_chunk");
$p_chunk = $current_chunk;
sleep(9);
}
}
}
}
}
}
}
sub get_stream {
my $uri = shift;
my $data = get("$uri");
}
##TCP impl. -PMM
sub handle_threads {
$tcp_stop = 1;
$thr->join();
}
sub end_xml{
my $filename;
my $twig = XML::Twig->new(pretty_print => 'indented');
my ($date,$time) = &get_date_time();
$filename = $opt_xml;
$filename = $date."_".$time.".xml" if $opt_xml eq "date_time";
open (MYFILE, '>'.$filename);
my $final_xml = $doc->toString();
$twig->parse($final_xml);
$twig->flush(\*MYFILE);
#print "</qstream> \n" if $opt_xml eq "-";
$doc->dispose;
close (MYFILE);
$xml_printed = 1;
}
sub tcp_packet_stats {
my ($pkt) = @_;
my $ip_obj = NetPacket::IP->decode(eth_strip($pkt));
my $tcp_obj = NetPacket::TCP->decode(ip_strip(eth_strip($pkt)));
my $us = 0;
my $f = $ip_obj->{src_ip}.":".$tcp_obj->{src_port};
my $seq_num = $tcp_obj->{seqnum};
my $options = $tcp_obj->{options}; #12 bytes
if (!exists $tcp_packet_stats{$f}){
$tcp_packet_stats{$f} = &share( {} );
$seq_stats{$f} = &share( {} );
$seq_stats_n{$f} = &share( {} );
$tcp_packet_stats{$f}{'pkt_late'} = 0;
$tcp_packet_stats{$f}{'pkt_retrans'} =0;
$tcp_packet_stats{$f}{'pkt_dup'} = 0;
}
++$tcp_packet_stats{'num_packets'};
++$tcp_packet_stats{$f}{'num_packets'};
$tc=[gettimeofday]; # current flow time
if( $t0){
$elapsed=tv_interval ( $t0, $tc);
} else {
$t0 = $tc;
$elapsed=0.0;
&init_stats($cur_id);
}
$us=$elapsed*10**6;
&tcp_jitter_stats($f,$options);
#Bandwidth messurements
&pkt_stats($f, $tcp_obj->{data}, $elapsed * 10**6, $ip_obj->{'len'});
$tcp_packet_stats{$f}{'num_bytes'} += $ip_obj->{'len'}; #counts the bytes
#Check for duplicated,out-of-order, late and lost packets.
$seq_stats{$f}{'seq_diff'} = $seq_num - $seq_stats{$f}{'p_seq_num'}- $seq_stats{$f}{'p_packet_len'};
if ($seq_stats_n{$f}{'seq_num_p'} == $seq_num && $seq_stats{$f}{'p_seq_num'} != 0) {
++$tcp_packet_stats{$f}{'pkt_dup'};
}
if ($seq_stats{$f}{'seq_diff'} != 0 && $seq_stats{$f}{'p_seq_num'} != 0){
if ($seq_stats{$f}{'seq_diff'} < 0){
++$tcp_packet_stats{$f}{'pkt_late'};
if ($seq_stats_n{$f}{'seq_num_n'} == $seq_num){
++$tcp_packet_stats{$f}{'pkt_retrans'};
}
}
else {
++$tcp_packet_stats{$f}{'pkt_lost'};
}
}
if($seq_stats{$f}{'p_seq_num'} < $seq_num){
$seq_stats{$f}{'n_seq_num'} = ($seq_num+$ip_obj->{len} -($ip_obj->{hlen}*4)-($tcp_obj->{hlen}*4))
}
$seq_stats{$f}{'p_seq_num'} = $seq_num;
$seq_stats{$f}{'p_packet_len'} = $ip_obj->{len}-($ip_obj->{hlen}*4)-($tcp_obj->{hlen}*4);
$seq_stats_n{$f}{'seq_num_p'} = $seq_num;
$seq_stats_n{$f}{'seq_num_n'} = $seq_stats{$f}{'n_seq_num'};
}
sub tcp_jitter_stats {
my $f = shift;
my $options = shift;
my $tcp_time_stamp_echo = unpack("N",substr($options,8,4));#from our client
my $tcp_time_stamp_delta = $tcp_time_stamp - $seq_stats{$f}{'p_tcp_time_stamp'};
my $tcp_time_stamp_echo_delta = $tcp_time_stamp_echo - $seq_stats{$f}{'p_tcp_time_stamp_echo'};
$seq_stats{$f}{'p_tcp_time_stamp'} = $tcp_time_stamp;
$seq_stats{$f}{'p_tcp_time_stamp_echo'} = $tcp_time_stamp_echo;
my $real_time_delta = time() - $seq_stats{$f}{'real_last_time'};
$seq_stats{$f}{'real_last_time'} = time();
#After AV streams starts
#$first_av_packet = &get_stream_start() if $opt_rtmp;
#$first_av_packet = $tcp_packet_stats{'num_packets'} if !$opt_rtmp and $opt_tcp;
if ($tcp_packet_stats{$f}{'num_packets'} > 1){
#gaps
$tcp_packet_stats{$f}{'gap_sum'} += $real_time_delta;
$tcp_packet_stats{$f}{'gap_square'} +=$real_time_delta**2;
if ($tcp_packet_stats{$f}{'gap_max'} < $real_time_delta){
$tcp_packet_stats{$f}{'gap_max'} = (10**3)*$real_time_delta;
}
if ($tcp_packet_stats{$f}{'gap_min'} > $real_time_delta){
$tcp_packet_stats{$f}{'gap_min'} = (10**3)*$real_time_delta;
}
my $jitter = abs($tcp_time_stamp_delta - $real_time_delta*10**3);
if($jitter > $tcp_packet_stats{$f}{'jitter_max'} ){
$tcp_packet_stats{$f}{'jitter_max'} = $jitter;
}
if($jitter < $tcp_packet_stats{$f}{'jitter_min'} ){
$tcp_packet_stats{$f}{'jitter_min'} = $jitter;
}
$tcp_packet_stats{$f}{'jitter_sum'} += $jitter;
$tcp_packet_stats{$f}{'jitter_square'} += $jitter**2;
}
else {
$tcp_packet_stats{$f}{'jitter_min'} = 2**31;
$tcp_packet_stats{$f}{'jitter_max'} = 0;
$tcp_packet_stats{$f}{'gap_max'} = 0;
$tcp_packet_stats{$f}{'gap_min'} = 2*31;
}
}
sub check_period {
my $f = shift;
if((($opt_last)+$start_time) < time() || (($opt_period)+$start_time) < time()){
$tcp_stop=1;
my $span = time() - $start_time;
&do_math($f,$span);
}
}
sub eat_tcp {
my $ip;
my $port;
if (!$opt_rtmp) {
$uri = shift;
$port = shift;
if ($ip !~ /^\d+\.\d+\.\d+\.\d+$/){
($ip,$port) = prepare_ip($uri);
}
my $f = $ip.":".$port;
if (! exists($tstart{$f})){
$tstart{$f} = [gettimeofday];
$first_us{$f}=$prev1s_us{$f}=$prevt100ms_us{$f}=$us;
if (! exists($setuptime{$f}) ){
if ( $pinterval){
$setuptime{$f}=0;
} else {
$setuptime{$f}=tv_interval ( $tjoined{$f}, $tstart{$f}) * 10**3;
}
printf "setup $f : %.3f\n", $setuptime{$f} if $opt_debug;
}
}
}
$ip = $rtmp_addr if $opt_rtmp;
$port = 1935 unless $port;
my ($net, $netmask, $filter_t, $err, $dev);
#my $time_out_ms = ($opt_last*10**3) || ($opt_period*10**3) if !$opt_last;
my $time_out_ms = 2000;
my $filter_str = "( (src $ip and port $port ) )";
$dev = Net::Pcap::lookupdev(\$err); # find a device
my $r = Net::Pcap::lookupnet( $dev, \$net, \$netmask, \$err);
my $pcap = Net::Pcap::open_live($dev, 1514, 1, $time_out_ms, \$err) || die "You need to run this as sudo $err";
$r=Net::Pcap::compile($pcap, \$filter_t, $filter_str, 0,$netmask);
$r=Net::Pcap::setfilter($pcap, $filter_t);
while (my $pkt=Net::Pcap::next($pcap,\%hdr)) { # get all packets
my $ip_obj = NetPacket::IP->decode(eth_strip($pkt));
my $tcp_obj = NetPacket::TCP->decode(ip_strip(eth_strip($pkt)));
if($tcp_obj->{src_port} == $port && $ip_obj->{src_ip} eq $ip ){
my $f = $ip_obj->{src_ip}.":".$tcp_obj->{src_port};
check_period($f) if $opt_last;
last if $tcp_stop==1;
&tcp_packet_stats($pkt);
}
}
}
##RTMP impl. -PMM
sub rtmp_eat_stream {
($rtmp,$period,$last,$reconnect,$debug,$swfurl,$pageurl,$flash_version) = @_;
($address, $app, $play) = rtmp_prepare_url($rtmp);
$rtmp_addr = $address;
$port = 1935 unless $opt_port;
my $f = $address.":".$port;
while(!$endstream){
$start_time = time();
if (! exists($tstart{$f})){
$tstart{$f} = [gettimeofday];
$first_us{$f}=$prev1s_us{$f}=$prevt100ms_us{$f}=$us;
if (! exists($setuptime{$f}) ){
if ( $pinterval){
$setuptime{$f}=0;
} else {
$setuptime{$f}=tv_interval ( $tjoined{$f}, $tstart{$f}) * 10**3;
}
printf "setup $f : %.3f\n", $setuptime{$f} if $opt_debug;
}
}
$thr = threads->new(\&eat_tcp) if $opt_tcp and !$reconnect;
rtmp_connect($address, '1935', $app , $swfurl, $pageurl,$flash_version) if $opt_rtmp;
rtmp_play($play, '-1.0', '-1.0', $period, $last,$debug) if $opt_rtmp;
&display_stats() if ($opt_period != $opt_last) and !$endstream;
my $pkt_stat = $thr->join if $opt_tcp;
last if $endstream;
}
}
sub rtmp_prepare_url{
my $uri = shift;
# return 0 if $uri != m/^(rtmp)://;
$uri =~ s/^(rtmp)://;
$uri =~ s#//##;
@string = split(/\//, $uri);
my $length = $#string;
my $host = $string[0];
my $app = '';
if ($host !~ /^\d+\.\d+\.\d+\.\d+$/){ # hostname
my $padr=gethostbyname($host) || die "Gethostbyname - $host - $padr : $!";
$address=Socket::inet_ntoa($padr);
}
for (my $i = 1; $i < $length;$i++){
$app .= $string[$i];
if ($i > 1 ){$app .="/";}
}
my $play = $string[$length];
return ($address,$app,$play)
}
#------------------------------------------------------------------------------
# unpack uri's to ip-address
sub prepare_ip {
my $uri=shift;
$uri =~ s/^(udp|rtp)://;
$uri =~ s/^(udp|rtp|http)://;
$uri =~ s#//##;
die "Unsupported streaming $1" if $uri =~/^(\w:)/;
if ($multicast = ($uri =~ /@/)){
......@@ -196,23 +480,19 @@ sub prepare_ip {
}
my @nib=split(/\./,$address);
$multicast = $multicast || $nib[0] >= 224 && $nib[0] <= 240;
return ($address, $port, $multicast);
}
sub eat_stream {
my $id=shift;
$tstart{$id}=[gettimeofday];
if ($opt_net && $opt_rtp){
# Create RTP socket
my $elapsed=0;
my $t0=0.0;
$n_packets=0;
my ($address, $port, $multicast) = prepare_ip($id);
my $rtp = new Net::RTP( LocalPort=>$port,
LocalAddr=>$address ) || die "Failed to create RTP socket: $!";
my $select=IO::Select->new($rtp->fileno);
......@@ -249,6 +529,7 @@ sub eat_stream {
$tjoined{$cur_id} = $tjoined if !$tjoined{$cur_id};
# No stats for that SSRC yet?
&pkt_stats($cur_id, $packet->encode, $elapsed * 10**6, $packet->size());
if ($opt_dump){
print DUMP $packet;
}
......@@ -261,7 +542,6 @@ sub eat_stream {
# $mc->shutdown; # gives error message
} elsif ($opt_net) { # udp stream
# Create UDP socket
......@@ -341,7 +621,7 @@ sub eat_stream {
my $tx0;
if (($fid, $seq, $src, $dst, $tx, $rx, $size)=
/ID=(\d+)\s+SEQ=(\d+)\s+SRC=([\d.:]+)\s+DST=([\d.:]+)\s+Tx=([\d.,]+)\s+Rx=([\d.,]+)\s+SIZE=(\d+)/){
/ID=(\d+)\s+SEQ=(\d+)\s+SRC=([\d.:]+)\s+DST=([\d.:]+)\s+Tx=([\d.,]+)\s+Rx=([\d.,]+)\s+SIZE=(\d+)/){
$flow_key="$src->$dst";
$flow_pkts{$flow_key}++;
......@@ -378,9 +658,9 @@ sub eat_stream {
} else {
if ($pcap=Net::Pcap::open_offline($pcap_file, \$err)){
# my $select=IO::Select->new(Net::Pcap::fileno($pcap));
until ( ! $uninterrupted || $endstream || ($opt_packets && $n_packets > $opt_packets)
|| ! (my $pkt=Net::Pcap::next($pcap, \%hdr) ) ) {
$file_flag =1;
eat_pcap($f, $pcap, $pkt);
$n_packets++;
}
......@@ -418,20 +698,19 @@ sub eat_pcap_streams{ # open groups and listen on pcap
$filter .= " )";
# $filter .= " and ip multicast";
# $filter ="ip";
my ($net, $netmask, $filter_t, $err, $dev);
# printf $filter;
$dev = Net::Pcap::lookupdev(\$err) || die "Could not lookupdev $dev : $err : $!";
$dev = Net::Pcap::lookupdev(\$err) || die "Could not lookupdev $dev : $err : $! .. Needs to run as sudo ..";
my $r = Net::Pcap::lookupnet( $dev, \$net, \$netmask, \$err);
die "Failed lookupnet for $dev : $r : $err : $!" if $r != 0;
$pcap=Net::Pcap::open_live( $dev, 100, 1, 0,\$err) || die "Could not open $dev : $err";
my $snap_length = 100;
$snap_length = 1514 if $opt_mpeg;
$pcap=Net::Pcap::open_live( $dev, $snap_length, 1, 0,\$err) || die "Could not open $dev : $err";
$r=Net::Pcap::compile($pcap, \$filter_t, $filter, 0, $netmask);
die "Could not compile filter : $r : $filter : $!)" if $r != 0;
$r=Net::Pcap::setfilter($pcap, $filter_t);
die "Could not set pcap filter : $r : $filter : $! " if $r != 0 ;
my $select=IO::Select->new( Net::Pcap::fileno($pcap));
while ($select->can_read($timeout) && (my $pkt=Net::Pcap::next($pcap, \%hdr)) ) { # get all packets
last if ! $uninterrupted || $endstream;
eat_pcap("pcap", $pcap, $pkt);
......@@ -440,22 +719,24 @@ sub eat_pcap_streams{ # open groups and listen on pcap
}
printf "%s\n", $ttl_log if $opt_ttl;
}
sub eat_pcap { # process pcap packets
sub eat_pcap { # process pcap packets
my ($f, $pcap, $pkt)=@_;
my $ip=null;
my $rtp = new Net::RTP::Packet(); # spare rtp obj
if (Net::Pcap::datalink($pcap) == 1){ # ethernet
$ip = NetPacket::IP->decode(eth_strip($pkt));
} elsif (Net::Pcap::datalink($pcap) == 113) { # DLT_LINUX_SLL
my ($head, $data)=unpack('a16a*', $pkt);
$ip = NetPacket::IP->decode($data);
} else {
die "Invalid link layer type : ".Net::Pcap::datalink($pcap);
}
&tcp_packet_stats($pkt) if $ip->{proto} == IP_PROTO_TCP;
$opt_tcp = 1 if $ip->{proto} == IP_PROTO_TCP;
next if $ip->{proto} != IP_PROTO_UDP;
my $udp = NetPacket::UDP->decode($ip->{data});
my $dlen = $ip->{len} - $ip->{hlen}*4;
......@@ -463,8 +744,12 @@ sub eat_pcap { # process pcap packets
if ($opt_sum){
$flow_key=$opt_sum;
} else {
$flow_key=sprintf "%s:%d->%s:%d",
}
elsif ($file_flag){
$flow_key = $f;
}
else {
$flow_key=sprintf "%s:%d->%s:%d",
$ip->{src_ip}, $udp->{src_port}, $ip->{dest_ip}, $udp->{dest_port};
}
$flow_pkts{$flow_key}++;
......@@ -495,8 +780,7 @@ sub eat_pcap { # process pcap packets
if ($flow_pkts{$flow_key} <= 1) { #
&init_stats($flow_key);
push (@myflows, $flow_key);
# printf "$flow_key\n";
push (@myflows, $flow_key);
}
$tc= [$hdr{tv_sec}, $hdr{tv_usec}];
if (! defined($t0)) {
......@@ -517,10 +801,8 @@ sub eat_pcap { # process pcap packets
&pkt_stats($flow_key, $udp->{data}, $us, $dlen);
}
sub init_stats {
my $f=shift;
$pinterval=0;
$npkt{$f}=$sumbyte{$f}=$ssbyte{$f}=0;
$first_sec=0;
......@@ -528,7 +810,7 @@ sub init_stats {
delete $prev_1s{$f}; delete $prev_100ms{$f};
delete $per1s{$f}; delete $per100ms{$f};
delete $sum1s{$f}; delete $sum100ms{$f};
$n100ms{$f}=0; $sum100ms{$f}=0; $ss100bps{$f}; $akk100ms{$f}=0;
$n100ms{$f}=0; $sum100ms{$f}=0; $ss100bps{$f}=0; $akk100ms{$f}=0;
$sumbyte{$f}=$sumps{$f}=0; # sum byte per second
$maxbps{$f}=0; $max100ms{$f}=0;
$dup{$f}=$lost{$f}=$late{$f}=0;
......@@ -539,15 +821,18 @@ sub init_stats {
$maxjitter{$f}=-2**63-5; $minjitter{$f}=2**63-5; delete $est_jitter{$f}; delete $pest_jitter{$f};
$first_port = 0; $n_seq=-1;
delete $tstart{$f}; delete $tend{$f};
#MPEG-TS initalizing and resetting (new period!)
$discontinuities = 0;
%last_ccs = ();
%mpeg_stats = ();
@cc = ();
# r_stats {filename/handle}
@pcr_stats{$f} = ();
#P-stats {filename/handle}
@pts_stats{$f} = ();
@pts_stats{$f,$TS} = ();
@mpeg_stats{$f} = ();
#P stuff
$late_video_packets = 0;
......@@ -555,7 +840,416 @@ sub init_stats {
%dist1 = ();
%dist2 = ();
$num_cc = 0;
}
sub format_numbers{
my $value = shift;