#!/usr/bin/perl use strict; use warnings; use Socket; use Getopt::Long qw(:config posix_default bundling); #use Net::Pcap qw(:functions); use Net::Pcap; use Net::Inspect::Debug qw(:DEFAULT %TRACE $DEBUG); use Net::Inspect::L2::Pcap; use Net::Inspect::L3::IP; use Net::Inspect::L4::UDP; ############################################################################ # Options ############################################################################ my ($infile,$dev,$nopromisc,@trace,$outdir); GetOptions( 'r=s' => \$infile, 'i=s' => \$dev, 'p' => \$nopromisc, 'h|help' => sub { usage() }, 'd|debug' => \$DEBUG, 'T|trace=s' => sub { push @trace,split(m/,/,$_[1]) }, 'D|dir=s' => \$outdir, ) or usage(); usage('only interface or file can be set') if $infile and $dev; $infile ||= '/dev/stdin' if ! $dev; my $pcapfilter = join(' ',@ARGV); $TRACE{$_} = 1 for(@trace); die "cannot write to $outdir: $!" if $outdir and ! -w $outdir || ! -d _; sub usage { print STDERR "ERROR: @_\n" if @_; print STDERR <new(XTract->new); my $raw = Net::Inspect::L3::IP->new($udp); my $pc = Net::Inspect::L2::Pcap->new($pcap,$raw); # Mainloop ############################################################################ my $time; print "Begin Main Loop\n"; pcap_loop($pcap,-1,sub { my (undef,$hdr,$data) = @_; if ( ! $time || $hdr->{tv_sec}-$time>10 ) { $udp->expire($time = $hdr->{tv_sec}); } return $pc->pktin($data,$hdr); },undef); package XTract; use base 'Net::Inspect::Connection'; use Net::Inspect::Debug; use Data::Dumper; my %rtp; sub pktin { my ($self,$data,$meta) = @_; my $m; # are these expected RTP data? print "Check for expected data\n"; my $s = XTract::RTPStream->new($meta,$m); $s->pktin(0,$data,$meta->{time}); return $s; # no connection for packets return; } package XTract::RTPStream; use base 'Net::Inspect::Connection'; use Net::Inspect::Debug; use fields qw(meta fh0 fh1 fh2 fh3); use Data::Dumper; sub new { my ($class,$meta) = @_; #print Dumper(@_); return bless { meta => $meta }, $class; } sub pktin { my ($self,$dir,$data,$time) = @_; #print Dumper(@_); $self->{expire} = $time + 30; # short expiration #print Dumper($self); # extract payload from RTP data my ($vpxcc,$mpt,$seq,$tstamp,$ssrc) = unpack( 'CCnNN',substr( $data,0,12,'' )); print "Dir: $dir\n"; my $fh = "fh$dir"; print "fh: $fh\n"; if ( ! $self->{$fh} ) { my $fname = sprintf "$outdir/%x-%s.%d-%s.%d-%08x.rtp", @{$self->{meta}}{qw(time saddr sport daddr dport)},$ssrc; open( $self->{$fh},'>',$fname) or die $!; } my $version = ($vpxcc & 0xc0) >> 6; #if ( $version != 2 ) { # debug("RTP version $version"); # return #} print sprintf("RTP Version %s, VPXCC: %s, MPT: %s, SEQ: %s, TS: %s, SSRC: %08x\n",$version,$vpxcc,$mpt,$seq,$tstamp,$ssrc); # skip csrc headers my $cc = $vpxcc & 0x0f; substr( $data,0,4*$cc,'' ) if $cc; # skip extension header my $xh = $vpxcc & 0x10 ? (unpack( 'nn', substr( $data,0,4,'' )))[1] : 0; substr( $data,0,4*$xh,'' ) if $xh; # ignore padding my $padding = $vpxcc & 0x20 ? unpack( 'C', substr($data,-1,1)) : 0; my $payload = $padding ? substr( $data,0,length($data)-$padding ): $data; # XXX if data are lost filling might be useful # XXX no duplicate detection sleep 1; syswrite($self->{$fh},$payload); return; }