Net-OSCAR

 view release on metacpan or  search on metacpan

snacsnatcher  view on Meta::CPAN

	}
}

sub process_xfer {
	my($time, $pkt, $conn_key) = @_;

	print "$time: $conn_key\n";
	$ft_states{$conn_key} = 1;

	my %ft_data = protoparse($session, "file_transfer_header")->unpack($$pkt);
	printf "\t[type=%04X] [encrypt=%d] [compress=%d] [files=%d/%d] [parts=%d/%d] [bytes=%d/%d]\n",
		delete @ft_data{qw(type encrypt compress files_left file_count parts_left part_count bytes_left byte_count)};

	print "\tHEADER IS NOT 256 BYTES!!\n" unless $ft_data{header_length} == 256;
	substr($$pkt, 0, $ft_data{header_length} + 4) = "";

	ssdump_hash(\%ft_data, 1);
	print "\n";
}

sub process_snac {
	my($time, $pkt, $conn_key) = @_;

	my($chan, $seqno, $len) = unpack("xCnn", substr($$pkt, 0, 6, ""));
	if(length($$pkt) < $len) {
		$snacbuff{$conn_key} = pack("CCnn", 42, $chan, $seqno, $len);
		$snacbuff{$conn_key} .= $$pkt;
		return;
	}
	my $snac = substr($$pkt, 0, $len, "");

	print "$time: $conn_key";
	printf " ch=%02X", $chan;

	my %snac_data = protoparse($session, "snac")->unpack($snac);
	printf " fl=%02X/%02X", $snac_data{flags1} || 0, $snac_data{flags2} || 0;
	printf " [%04X/%04X]", $snac_data{family} || 0, $snac_data{subtype} || 0;

	my $protobit = snac_to_protobit(%snac_data);
	if(!$protobit) {
		print " == UNKNOWN";
		print hexdump($snac_data{data}, 1);
		print "\n";
	} else {
		print " == $protobit\n";
		my %data = protoparse($session, $protobit)->unpack($snac_data{data});
		if($protobit =~ /^buddylist_(add|modify|delete)$/) {
			%data = protoparse($session, "buddylist_change")->unpack($snac_data{data});
		}

		if($protobit =~ /^(incoming|outgoing)_IM$/) {
			my $channel_data;

			if($data{channel} == 1) {
				$channel_data = {protoparse($session, "standard_IM_footer")->unpack($data{message_body})};
			} elsif($data{channel} == 2) {
				$channel_data = {protoparse($session, "rendezvous_IM")->unpack($data{message_body})};
				my $type = OSCAR_CAPS_INVERSE()->{$channel_data->{capability}};

				if($type eq "chat") {
					$channel_data->{svcdata} = {protoparse($session, "chat_invite_rendezvous_data")->unpack($channel_data->{svcdata})};
				} elsif($type eq "filexfer") {
					$channel_data->{svcdata} = {protoparse($session, "file_transfer_rendezvous_data")->unpack($channel_data->{svcdata})};
				} elsif($type eq "sendlist") {
					$channel_data->{svcdata} = {protoparse($session, "buddy_list_transfer_rendezvous_data")->unpack($channel_data->{svcdata})};
				}
			} else {
				$channel_data = $data{message_body};
			}

			$data{message_body} = $channel_data;
		}

		ssdump_hash(\%data, 1);
	}

	print "\n";
}

my $pcap = Net::Pcap::open_offline($file, \$!) or die "Couldn't open $file: $!\n";
$datalink = Net::Pcap::datalink($pcap);
Net::Pcap::dispatch($pcap, 0, \&got_packet, undef);
Net::Pcap::close($pcap);



( run in 0.551 second using v1.01-cache-2.11-cpan-13bb782fe5a )