This wiki has been migrated to https://gitlab.com/wireshark/wireshark/-/wikis/home and is now deprecated. Please use that site instead.

Attachment 'ugly_call_splitter.pl'

Download

   1 #!/usr/bin/perl
   2 # vig_splitter, Luis.Ontanon.IBM@h3g.it 07/2004
   3 # splitts a vig caputure session into several ones
   4 # each containing the packets of a single call
   5 #
   6 # usage: vig_splitter in_file.cap 'filter'
   7 #
   8 # Features missing:
   9 # - reporting: start, end, release cause, number of h245 commands, etc...
  10 # - filter: a-number or b-number based filtering 
  11 # - duplicates out (checking the payload of consecutive packets)
  12 # - live capture (check for leaks)
  13 # - configuration file
  14 # - only signalling flag
  15 # - RTSP
  16 #
  17 # Known bugs:
  18 # - packets for a call coming after all RLCs are lost
  19 #
  20 # To Do:
  21 # - (re)write decoders as NetPacket modules
  22 #    NetPacket::SCTP
  23 #    NetPacket::M3UA
  24 #    NetPacket::MTP3
  25 #    NetPacket::ISUP
  26 #    NetPacket::Q931
  27 #    NetPacket::MEGACO
  28 #
  29 
  30 use strict;
  31 use Net::Pcap;
  32 use NetPacket::Ethernet qw(:strip) ;
  33 use NetPacket::IP qw(:strip);
  34 use NetPacket::UDP qw(:strip);
  35 use NetPacket::TCP qw(:strip);
  36 
  37 $| = 1;
  38 # Am I debugging this code (the bigger the value the most junk you get!)
  39 my $DEBUG = 0;
  40 
  41 # dpc of the mgc
  42 my $MGC_DPC = 6017;
  43 
  44 # spans defined in mgc/mg
  45 my %MGC_DS1 = %{ {
  46 	5378 => {
  47 		0 => '0/1',
  48 		32 => '1/1'
  49 	},
  50 	11522 => {
  51 		0 => '1/2',
  52 		32 => '3/1'
  53 	} } };
  54 			
  55 
  56 my $a;
  57 my $a_number = undef;
  58 my $b_number = undef;
  59 my $dups_out = 0;
  60 my $in_file = undef;
  61 while ($a = shift) {
  62 	if ($a eq '-a') {
  63 		$a_number = shift;
  64 	} elsif ($a eq '-b') {
  65 		$b_number = shift;
  66 	} elsif ($a eq '-d') {
  67 		$dups_out = 1;
  68 	} elsif (not defined $in_file && -f $a) {
  69 		$in_file = $a;
  70 	} else {
  71 		die "usage: vig_split [-a filter] [-b filter] [-d] in_file.cap"
  72 	}
  73 }
  74 
  75 
  76 my %ISUP;
  77 my %isup;
  78 my %isup_opt;
  79 init_hashes();
  80 
  81 my %calls = ();  
  82 my %cics = ();
  83 my %ctxs = ();
  84 my %trxs = ();
  85 my %ds1s = ();
  86 my %id2ds1 = ();
  87 my %call2ds1 = ();
  88 my %cr =();
  89 my %rtp = ();
  90 my %ctx_rtp = ();
  91 
  92 my ($err, $pcap_in, $pcap_out, $pcap_t, $pkt, $i);
  93 
  94 $i = 0 ;
  95 $pcap_in = Net::Pcap::open_offline($in_file, \$err);
  96 
  97 while (1) {
  98 	$i++;
  99 	my %h = ();
 100 	my $pkt = Net::Pcap::next($pcap_in, \%h);
 101 	last unless defined $pkt;
 102 	
 103 	# backup paket data for dumping it later
 104 	my %H = %h; my $PKT = $pkt;
 105 
 106 	decode_packet(\%h,$pkt);
 107 
 108 	if ($h{ip_proto} == 0x11 ) { # udp for rtp
 109 		my $id = undef;
 110 
 111 		print " $i: RTP $h{ip_src_ip}:$h{src_port} > $h{ip_dest_ip}:$h{dest_port}\n" if $DEBUG;
 112 		if ( exists $rtp{"$h{ip_src_ip}:$h{src_port}"} ) {
 113 			$id = $rtp{"$h{ip_src_ip}:$h{src_port}"};
 114 		} elsif ( exists $rtp{"$h{ip_dest_ip}:$h{dest_port}"} ) {
 115 			$id = $rtp{"$h{ip_dest_ip}:$h{dest_port}"};
 116 		}
 117 
 118 		next unless exists $calls{$id};
 119 		Net::Pcap::dump(${$calls{$id}}{pcap},\%H,$PKT);
 120 		     
 121 	} elsif (exists $h{call_ref}) { # h323 
 122 
 123 		if ($h{msg_type} == 5) { # SETUP
 124 			next if defined $a_number and $h{caller} != $a_number;
 125 			next if defined $b_number and $h{called} != $b_number;
 126 	
 127 			my $id = "$h{caller}-$h{called}";
 128 
 129 			unless ($id =~ /^\d+-\d+$/) {
 130 				print " $i: Q931 SETUP $h{call_ref} botched: $id\n" if $DEBUG;
 131 				next;
 132 			}
 133 			print " $i: Q931 SETUP $h{call_ref} belongs to '$id'\n" if $DEBUG;
 134 
 135 			unless ( exists $calls{$id} ) {
 136 				my $filename = "$h{tv_sec}-$id.cap";
 137 				${$calls{$id}}{pcap} = Net::Pcap::dump_open($pcap_in, $filename);
 138 				print " $i: started call $id into $filename\n" if $DEBUG;
 139 			} 
 140 
 141 			${${$calls{$id}}{q931}}{$h{call_ref}} = '';
 142 			$cr{$h{call_ref}} = $id;
 143 			Net::Pcap::dump(${$calls{$id}}{pcap},\%H,$PKT);
 144 		} elsif ($h{msg_type} == 0x5a) { # RLC
 145 			my $id = $cr{$h{call_ref}};
 146 			print " $i: Q931 RLC $h{call_ref} belongs to '$id'\n" if $DEBUG;
 147 			next unless exists $calls{$id};
 148 			Net::Pcap::dump(${$calls{$id}}{pcap},\%H,$PKT);
 149 			delete $cr{$h{call_ref}};
 150 			delete ${${$calls{$id}}{q931}}{$h{call_ref}};
 151 			
 152 			# close if last leg of call
 153 			close_on_last($id);
 154 			
 155 		} elsif ( exists $cr{$h{call_ref}} ) {
 156 			my $id = $cr{$h{call_ref}};
 157 			print " $i: Q931($h{msg_type}) $h{call_ref} belongs to '$id'\n" if $DEBUG;
 158 			next unless exists $calls{$id};
 159 			Net::Pcap::dump(${$calls{$id}}{pcap},\%H,$PKT);
 160 		}
 161 
 162 	} elsif (exists $h{trx_id}) { # MeGaCo
 163 
 164 		if ($DEBUG) {
 165 			my $b = '';
 166 			/term_DS1|command_DS1/ and $b .= "$_ = '$h{$_}'  " for (keys %h);
 167 			print " $i: h248 $h{ctx} $b\n" if $DEBUG;
 168 		}
 169 
 170 		if ($h{ctx} == '$') { # create context
 171 			my $ds1 = undef;
 172 			for my $d (keys %ds1s) {
 173 				if (exists $h{"term_$d"}) {
 174 					$ds1 = $d;
 175 					last;
 176 				}
 177 			}
 178 			my $id =  $ds1s{$ds1};
 179 			$trxs{$h{trx_id}} = $id;
 180 			delete $ds1s{$ds1};
 181 			
 182 			next unless exists $calls{$id};
 183 			print " $i: h248 'create' belongs to $id\n" if $DEBUG;
 184 			Net::Pcap::dump(${$calls{$id}}{pcap},\%H,$PKT);
 185 		} elsif (exists $trxs{$h{trx_id}}) { # reply to create has ctx_id
 186 			my $id =  $trxs{$h{trx_id}};
 187 			next unless exists $calls{$id};
 188 			Net::Pcap::dump(${$calls{$id}}{pcap},\%H,$PKT);
 189 			my $ctx = $h{ctx};
 190 			$ctxs{$ctx} = $id;
 191 			delete $trxs{$h{trx_id}};
 192 			# RTP stuff here
 193 			my $rtpid = "$h{mg_rtp_addr}:$h{mg_rtp_port}";
 194 			$rtp{$rtpid} = $id;
 195 			$ctx_rtp{$ctx} = $rtpid;
 196 			print " $i: h248 'create reply' for $h{trx_id} belongs to $id rtp: $rtpid\n" if $DEBUG;
 197 		} elsif (exists $ctxs{$h{ctx}} ) { # all other defined contexts has to be dumped
 198 			my $id = $ctxs{$h{ctx}};
 199 			next unless exists $calls{$id};
 200 			Net::Pcap::dump(${$calls{$id}}{pcap},\%H,$PKT);
 201 			if ( $h{trx_type} eq 'Reply' and $h{'command_*'} eq 'Subtract') {
 202 				print " $i: h248 last packet of context $h{ctx}\n" if $DEBUG;
 203 				delete $ctxs{$h{ctx}};
 204 				delete $id2ds1{$id};
 205 				my $rtpid = $ctx_rtp{$h{ctx}};
 206 				delete $rtp{$rtpid};
 207 				delete $ctx_rtp{$h{ctx}};
 208 			}
 209 		}
 210 	} elsif (exists $h{isup_cic}) { # isup
 211 		my $dpc = $MGC_DPC == $h{mtp3_opc} ? $h{mtp3_dpc} : $h{mtp3_opc};
 212 		my $cic = "$dpc:$h{isup_cic}";
 213 		my $id = exists $cics{$cic} ? $cics{$cic} : undef;
 214 		if ( $h{isup_type} == 1 ) {
 215                         next if defined $a_number and $h{caller} != $a_number;
 216                         next if defined $b_number and $h{called} != $b_number;
 217 
 218 			my ($caller, $called) = @h{'caller','called'};
 219 			$called =~ s/F$//;
 220 			my $ts = $h{tv_sec};
 221 			my $filename = "$ts-$caller-$called.cap";
 222 			my $id = "$caller-$called";
 223 			my $ds1 = cic2ds1($cic);
 224 			print " $i: IAM($cic $ds1): belongs to $id\n" if $DEBUG;
 225 
 226 			unless ( exists $calls{$id} ) {
 227 	                        my $ts = $h{tv_sec};
 228 	                        my $filename = "$ts-$caller-$called.cap";
 229 				print " $i: IAM call '$id' doesn't exists already opening file\n" if $DEBUG;
 230 				${$calls{$id}}{pcap} = Net::Pcap::dump_open($pcap_in, $filename);
 231 			}
 232 			${$calls{$id}}{isup} = $cic;
 233 			$ds1s{$ds1} = $id;
 234 			$id2ds1{$id} = $ds1;
 235 			$cics{$cic} = $id;
 236 
 237 			Net::Pcap::dump(${$calls{$id}}{pcap},\%H,$PKT);
 238 		} elsif ( $h{isup_type} == 16 ) {
 239 			print " $i: RLC $h{isup_cic}\n" if $DEBUG;
 240 			next unless exists $calls{$id};
 241 			Net::Pcap::dump(${$calls{$id}}{pcap},\%H,$PKT);
 242 			# close if last leg
 243 			delete ${$calls{$id}}{isup};
 244 			close_on_last($id);
 245 		} else {
 246 			print " $i: ISUP $h{isup_type} $h{isup_cic}\n" if $DEBUG;
 247 			next unless exists $calls{$id};
 248 			my $d = Net::Pcap::dump(${$calls{$id}}{pcap},\%H,$PKT);
 249 		}
 250 	}
 251 }
 252 
 253 Net::Pcap::close($pcap_in);
 254 
 255 exit;
 256 
 257 sub close_on_last {
 258 	my $id = shift;
 259 	my $n = 0;
 260 	$n++ for (keys %{${$calls{$id}}{q931}});
 261 	$n++ if (exists ${$calls{$id}}{isup});
 262 	print "  $i: close_on_last for '$id' has $n legs left\n" if $DEBUG;
 263 	if ($n == 0) {
 264 		Net::Pcap::dump_close(${$calls{$id}}{pcap});
 265 		delete $calls{$id};
 266 	}
 267 }
 268 
 269 sub cic2ds1 {
 270 	my $id = shift;
 271 	my ($dpc,$cic) = split /:/, $id;
 272 	my $t = $cic % 32;
 273 	my $d = $cic - $t;
 274 	
 275 	return "DS1/${$MGC_DS1{$dpc}}{$d}/$t";
 276 }
 277 
 278 sub decode_packet {
 279 	my $h = shift;
 280 	my $pkt = shift;
 281 
 282         ##### Decode the packet into %h
 283         my $ip = NetPacket::IP->decode(eth_strip($pkt));
 284         ${$h}{"ip_$_"} = ${$ip}{$_} for (keys %{$ip});
 285 
 286         if ( ${$h}{ip_proto} == 0x84 ) { # SCTP
 287 
 288                 # SCTP Header
 289                 @{$h}{'sctp_src_port', 'sctp_dst_port', 'sctp_verif', 'chksum','junk'}
 290                         = unpack "nnNN*",${$h}{ip_data};
 291                 delete ${$h}{junk};
 292 
 293                 my $left = ${$h}{ip_data};
 294                 $left =~ s/^.{12}//ms;
 295 
 296                 my %s = parse_sctp_chunks($left);
 297                 ${$h}{$_} = $s{$_} for (keys %s);
 298 
 299         } elsif ( ${$h}{ip_proto} == 0x06) {
 300                 my $tcp = NetPacket::TCP->decode(ip_strip(eth_strip($pkt)));
 301                 ${$h}{$_} = ${$tcp}{$_} for (keys %{$tcp});
 302 
 303                 if (${$h}{dest_port} == 1720 or ${$h}{src_port} == 1720 or ${$h}{dest_port} == 1721 or ${$h}{src_port} == 1721) { # H323
 304                         my %q = parse_h323_message(${$h}{data});
 305                         ${$h}{$_} = $q{$_} for (keys %q);
 306                 }
 307         } elsif ( ${$h}{ip_proto} == 0x11 ) {
 308 		my $udp = NetPacket::UDP->decode(ip_strip(eth_strip($pkt)));
 309 		${$h}{$_} = ${$udp}{$_} for (keys %{$udp});
 310         }
 311 
 312 }
 313 
 314 sub parse_h323_message {
 315 	$_ = $_[0];
 316 	my %q = ();
 317 	#print "   h323($i): " . bin2hex($_) . "\n";
 318 	
 319 	my ($tver,$tres,$tlen,$proto,$crlen,$call_ref,$msg_type) = unpack "CCnCCnC",$_;
 320 	return () if $tver ne 3;
 321 	$call_ref -= 32768 if $call_ref > 32768;
 322 	print " h323($i): vers: $tver len: $tlen proto: $proto call_ref: $call_ref msg_type: $msg_type\n" if $DEBUG > 2;
 323 	printf " h323($i): call ref = %0.2X\n",$call_ref if $DEBUG > 2;
 324 	@q{'call_ref','msg_type'} = ($call_ref,$msg_type);
 325 
 326 	my $b = $_;
 327 	$b =~ s/^.{9}//ms;
 328 	if ($msg_type == 5 ) { # q931 SETUP
 329                 while(1) {
 330                         $b =~ s/^(..)//ms or last;
 331                         my ($t,$l) = unpack "CC", $1;
 332                         $b =~ s/^(.{$l})//ms;
 333                         my $data = $1;
 334                         print "   h323($i): option: $t len: $l data: " . bin2hex($data) . "\n" if $DEBUG > 2;
 335 	
 336                         if ($t == 0x6c ) { # calling party
 337                                 $data  =~ s/^(..)//ms;
 338 				print " h323($i): calling number: $data\n" if $DEBUG > 2;
 339 				$q{caller} = $data;
 340                         } elsif ($t == 0x70) { # called party
 341 				$data  =~ s/^(.)//ms;
 342                                 print " h323($i): called number: $data\n" if $DEBUG > 2;
 343 				$q{called} = $data;
 344 			} elsif ($t == 0x74) {
 345 				$data  =~ s/^(..)//ms;
 346 				print " h323($i): redirecting number: $data\n" if $DEBUG > 2;
 347 				$q{redirecting} = $data;
 348 			}
 349 			
 350                 }
 351 	}
 352 
 353 	return %q;
 354 }
 355 
 356 
 357 sub parse_sctp_chunks {
 358 	my $b = shift;
 359 	my %c = ();
 360 
 361 	my $len = (length $b) - 14;
 362 	my ($t,$f,$l,$tsn,$s,$n,$p,$j) = unpack "ccnNnnN*",$b;
 363 	print "  sctp $t $p\n" if $DEBUG > 2;
 364 	
 365 	@c{'sctp_type','sctp_proto'} = ($t,$p);
 366 
 367 	my  $len = $l - 16;
 368 	$b =~ s/^.{16}(.{$len})//ms or die "no match";
 369 	$c{msg} = $1;
 370 
 371 	if ( $t != 0 ) {
 372 		return undef;
 373 	} elsif ($p == 7) { # MEGACO
 374 		my %m = parse_megaco($c{msg});
 375 		$c{$_} = $m{$_} for (keys %m);
 376 	} elsif ($p == 3) { # M3UA (isup)
 377 		my %i = parse_isup($c{msg});
 378 		$c{$_} = $i{$_} for (keys %i);
 379 	}
 380 
 381 	return %c;
 382 }
 383 
 384 sub parse_megaco {
 385 	$_ = $_[0];
 386 	my %m = ();
 387 
 388 	s/\n/ /g;
 389 	s/(\s)+/ /g;
 390 
 391 	my $d = $_[0];
 392 	$d =~ s/\n/\n megaco($i)\|\t/gms;
 393 	print $d if $DEBUG > 5;
 394 	
 395 	@m{'trx_type','trx_id'} = ($1,$2) if s/(Transaction|Reply)\s+=\s+([0-9]+)[^{]*\{(.*)\}/$3/msi;
 396 
 397 	$m{ctx} = $1 if s/Context\s+=\s+([0-9]+|\$)[^{]*\{(.*)\}/,$2/;
 398 	print " megaco($i): @m{'trx_type','trx_id'}  ctx = $m{ctx}\n" if $DEBUG > 2;
 399 
 400 	$_ .= ',';
 401 
 402 	s/(Modify|Notify|Add|Substract)/#$1#/gms;
 403 
 404 
 405 	while (s@#(Modify|Notify|Add|Substract)#.*?=.*?((RTP|MUX|DS1)/([0-9/]+|\$|\*))([^#]*)@@msi) {
 406 		my ($cmd,$term,$param,$type) = ($1,$2,$5,$3);	
 407 		my $c = "command_$term";
 408 		my $t = "term_$term";
 409 		my $p = "param_$term";
 410 
 411 		next unless defined $cmd;
 412 		print "megaco($i): term $c: '$cmd' $t: '$term'\nmegaco($i) param($term): $param\n" if $DEBUG > 2;
 413 		@m{$c,$t,$p} = ($cmd,$term,$param);
 414 		
 415 		if ($type == 'RTP' and $param =~ /c=IN IP4 ([0-9.]+).*m=audio (\d+).*a=rtpmap:(\d+ \S+)/ ) {
 416 			@m{'mg_rtp_addr','mg_rtp_port','mg_rtp_media'} = ($1,$2,$3);
 417 			print "megaco($i): RTP: @m{'mgc_rtp_addr','mgc_rtp_port','mgc_rtp_media'}\n" if $DEBUG > 2;
 418 		}
 419 			
 420 	}
 421 
 422 	return %m;
 423 	
 424 }
 425 
 426 sub init_hashes {
 427 	%isup = %{{
 428 		1 => 'IAM',
 429 		6 => 'ACM',
 430 		9 => 'ANM',
 431 		12 => 'REL',
 432 		16 => 'RLC'
 433 	}};
 434 	
 435 	%ISUP = %{{
 436 		IAM => 1,
 437 		ACM => 6,
 438 		ANM => 9,
 439 		REL => 12,
 440 		RLC => 16
 441 	}};
 442 
 443 	%isup_opt = %{{
 444 		10 => 'caller',
 445 		11 => 'redirecting',
 446 		40 => 'original',
 447 		63 => 'location'
 448 	}};
 449 }
 450 
 451 sub parse_isup {
 452 	my $b = shift;
 453 	print "\tisup($i): " . bin2hex($b) . "\n" if $DEBUG > 2;
 454 	my ($v,$r,$c,$t,$l1,$d,$l2,$sio,$rl,$cic,$cic2,$type)
 455 		= unpack "CCCCNnnCVCCC", $b;
 456 	$cic = 256 * $cic2 + $cic;
 457 	$b =~ s/^.{20}//ms;
 458 	my $sls = ($rl & 0xf0000000) >> 18;
 459 	my $opc = ($rl & 0x0fffc000) >> 14;
 460 	my $dpc = ($rl & 0x00003fff);
 461 	printf "   isup($i): $opc -> $dpc: $isup{$type} cic: $cic\n" if $DEBUG > 2;
 462 	
 463 	my %i = ();
 464 	@i{'m3ua_version','m3ua_class','m3ua_type'} = ($v,$c,$t);
 465 	@i{'mtp3_sio','mtp3_opc','mtp3_dpc','mtp3_sls'} = ($sio, $opc, $dpc, $sls);
 466 	@i{'isup_cic','isup_type'} = ($cic,$type);
 467 	
 468 	if( $type == 1 ) { # IAM
 469 		my ($nci,$fci,$ac,$medium,$ptr,$opt_ptr,$len,$f1,$f2) = unpack "cnccccccc", $b;		
 470 		$i{isup_medium} = $medium;
 471 		
 472 		#print "isup before: " . bin2hex($b) . "\n" if $DEBUG > 2;
 473 		$b =~ s/^.{10}//ms;
 474 		
 475 		my $called = '';
 476 		
 477 		$len -= 2;
 478 		while($len--) {
 479 			$b =~ s/^(.)//ms;
 480 			my $h = sprintf '%0.2X',unpack 'C',$1;
 481 			$h =~ s/(.)(.)/$2$1/;
 482 			$called .= $h;
 483 		}
 484 		$called =~ s/0$//;
 485 		print "   isup($i): called number: $called\n" if $DEBUG > 2;
 486 		$i{called} = $called;
 487 
 488 		#print "isup before options:" . bin2hex($b) . "\n" if $DEBUG > 2;
 489 		
 490 		
 491                 while(1) {
 492                         $b =~ s/^(..)//ms or last;
 493 			my ($t,$l) = unpack "CC", $1;
 494 			$b =~ s/^(.{$l})//ms;
 495 			my $data = $1;
 496 			print "   isup($i): option: $t len: $l data: " . bin2hex($data) . "\n" if $DEBUG > 2;
 497 			if ($t == 10 || $t == 11 || $t == 40 || $t == 63) { # calling party
 498 				$data  =~ s/^(..)//ms;
 499 				$l -= 2;
 500 				my $number = '';
 501 				while ($l--) {
 502 		                        $data =~ s/^(.)//ms;
 503 					my $h = sprintf '%0.2X',unpack 'C',$1;
 504 		                        $h =~ s/(.)(.)/$2$1/;
 505 					$number .= $h;
 506 				}
 507 
 508 				print "   isup($i): $isup_opt{$t} number: $number\n" if $DEBUG > 2;
 509 				$i{$isup_opt{$t}} = $number;
 510 			}
 511                 }
 512 
 513 		
 514 	}
 515 
 516 	return %i;
 517 }
 518 
 519 sub bin2hex {
 520 	my $b = '';
 521 	for my $a (@_) {
 522 		for my $c (split //ms, $a) {
 523 		$b .= sprintf ("%.2X:",unpack 'C', $c);
 524 		}
 525 	}
 526 	$b =~ s/:$//;
 527 	return $b;
 528 }

Attached Files

To refer to attachments on a page, use attachment:filename, as shown below in the list of files. Do NOT use the URL of the [get] link, since this is subject to change and can break easily.
  • [get | view] (2005-01-30 01:03:34, 13.9 KB) [[attachment:ugly_call_splitter.pl]]
 All files | Selected Files: delete move to page copy to page

You are not allowed to attach a file to this page.