Sip/Checksum.pm

   1 #
   2 # Copyright (C) 2006-2008  Georgia Public Library Service
   3 #
   4 # Author: David J. Fiander
   5 #
   6 # This program is free software; you can redistribute it and/or
   7 # modify it under the terms of version 2 of the GNU General Public
   8 # License as published by the Free Software Foundation.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public
  16 # License along with this program; if not, write to the Free
  17 # Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
  18 # MA 02111-1307 USA
  19
  20 package Sip::Checksum;
  21
  22 use Exporter;
  23 use strict;
  24 use warnings;
  25
  26 our @ISA = qw(Exporter);
  27 our @EXPORT_OK = qw(checksum verify_cksum);
  28
  29 sub checksum {
  30     my $pkt = shift;
  31
  32     return (-unpack('%16C*', $pkt) & 0xFFFF);
  33 }
  34
  35 sub verify_cksum {
  36     my $pkt = shift;
  37     my $cksum;
  38     my $shortsum;
  39
  40     return 0 if (substr($pkt, -6, 2) ne "AZ"); # No checksum at end
  41
  42     # Convert the checksum back to hex and calculate the sum of the
  43     # pack without the checksum.
  44     $cksum = hex(substr($pkt, -4));
  45     $shortsum = unpack("%16C*", substr($pkt, 0, -4));
  46
  47     # The checksum is valid if the hex sum, plus the checksum of the
  48     # base packet short when truncated to 16 bits.
  49     return (($cksum + $shortsum) & 0xFFFF) == 0;
  50 }
  51
  52 {
  53     no warnings qw(once);
  54     eval join('',<main::DATA>) || die $@ unless caller();
  55 }
  56 __END__
  57
  58 #
  59 # Some simple test data
  60 #
  61 sub test {
  62     my $testpkt = shift;
  63     my $cksum = checksum($testpkt);
  64     my $fullpkt = sprintf("%s%4X", $testpkt, $cksum);
  65
  66     print $fullpkt, "\n";
  67 }
  68
  69 while (<>) {
  70     chomp;
  71     test($_);
  72 }
  73
  74 1;