Sip/Checksum.pm

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