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