C4/SIP/Sip/Checksum.pm

   1 package Sip::Checksum;
   2
   3 use Exporter;
   4 use strict;
   5 use warnings;
   6
   7 our @ISA = qw(Exporter);
   8 our @EXPORT_OK = qw(checksum verify_cksum);
   9 our $debug = 0;
  10
  11 sub checksum {
  12     my $pkt = shift;
  13     return (-unpack('%16C*', $pkt) & 0xFFFF);
  14 }
  15
  16 sub verify_cksum {
  17     my $pkt = shift;
  18     my $cksum;
  19     my $shortsum;
  20
  21         if ($pkt =~ /AZ(....)$/) {
  22                 $debug and warn "verify_cksum: sum ($1) detected";
  23         } else {
  24                 warn "verify_cksum: no sum detected";
  25                 return 0; # No checksum at end
  26         }
  27     # return 0 if (substr($pkt, -6, 2) ne "AZ");
  28
  29     # Convert the checksum back to hex and calculate the sum of the
  30     # pack without the checksum.
  31     $cksum = hex($1);
  32     $shortsum = unpack("%16C*", substr($pkt, 0, -4));
  33
  34     # The checksum is valid if the hex sum, plus the checksum of the
  35     # base packet short when truncated to 16 bits.
  36     return (($cksum + $shortsum) & 0xFFFF) == 0;
  37 }
  38
  39 {
  40     no warnings qw(once);
  41     eval join('',<main::DATA>) || die $@ unless caller();
  42         # FIXME: what the heck is this?
  43 }
  44
  45 1;
  46 __END__
  47
  48 #
  49 # Some simple test data
  50 #
  51 sub test {
  52     my $testpkt = shift;
  53     my $cksum = checksum($testpkt);
  54     my $fullpkt = sprintf("%s%4X", $testpkt, $cksum);
  55
  56     print $fullpkt, "\n";
  57 }
  58
  59 while (<>) {
  60     chomp;
  61     test($_);
  62 }
  63
  64 1;